Adding a subplot to each facet_wrap using same facet data

user_14333346 0
Viewed 268

I try to add histogram suplots to each partial geom_sf plot of a facet_wrap plot based on the same data as in the respective facet_wrap plot.

I have found some approaches via Google, but so far nothing concrete.

My previous approach:

library(sf)
library(ggplot2)

nc <- st_read(system.file("shape/nc.shp", package="sf"))
nc <- rbind(nc, nc[rep(1:100, 3), ])
nc <- nc[order(nc$NAME),]
nc$GROUP <- c("A", "B", "C", "D")
nc$VALUE <- runif(400, min=0, max=10)

main <- ggplot() +
  geom_sf(data = nc,
          aes(fill = VALUE),
          color = NA) +
  scale_fill_gradientn(colours = c("#f3ff2c", "#96ffea", "#00429d"),
                       guide = "colorbar") +
  coord_sf(datum = NA) +
  theme(panel.background = element_blank(),
        strip.background = element_blank(),) +
  facet_wrap(~ GROUP, nrow = 2)

sub <- ggplot(nc, aes(x=VALUE)) + 
  geom_histogram(binwidth = 1) +
  theme_minimal(base_size=9) +
  theme(panel.background = element_blank(),
        strip.background = element_blank(),) +
  facet_wrap(~ GROUP, nrow = 2)

main + annotation_custom(grob = ggplotGrob(sub))

any idea how i can achive this?

facet-wrap subplot ggplot2 r
1 Answers

Makung use of the patchwork package this could be achieved like so:

  1. Make separate plots for each of the groups. To this end you can wrap your plotting code in a function and loop over the groups using e.g. lapply.

  2. For the histograms you can go on with your approach using annotation_custom or make use of patchwork::inset_element as I do.

  3. Glue the plots together and collect the guides. To this end it's important to set the same limits for the fill scale in each plot.

library(sf)
#> Linking to GEOS 3.8.0, GDAL 3.0.4, PROJ 6.3.1
library(ggplot2)

nc <- st_read(system.file("shape/nc.shp", package="sf"))
#> Simple feature collection with 100 features and 14 fields
#> geometry type:  MULTIPOLYGON
#> dimension:      XY
#> bbox:           xmin: -84.32385 ymin: 33.88199 xmax: -75.45698 ymax: 36.58965
#> geographic CRS: NAD27
nc <- rbind(nc, nc[rep(1:100, 3), ])
nc <- nc[order(nc$NAME),]
nc$GROUP <- c("A", "B", "C", "D")
nc$VALUE <- runif(400, min=0, max=10)

make_plot <- function(data) {
  main <- ggplot() +
    geom_sf(data = data,
            aes(fill = VALUE),
            color = NA) +
    scale_fill_gradientn(colours = c("#f3ff2c", "#96ffea", "#00429d"),
                         guide = "colorbar", limits = c(0, 10)) +
    coord_sf(datum = NA) +
    theme(panel.background = element_blank(),
          strip.background = element_blank()) +
    facet_wrap(~ GROUP)
  
  sub <- ggplot(data, aes(x=VALUE)) + 
    geom_histogram(binwidth = 1) +
    theme_minimal(base_size = 5) +
    theme(panel.background = element_blank(),
          strip.background = element_blank(),
          plot.margin = margin(0, 0 , 0, 0))

  main + inset_element(sub, 0, 0, .4, .35)
}

library(patchwork)
library(magrittr)

p <- nc %>% 
  split(.$GROUP) %>% 
  lapply(make_plot) 

p %>% 
  wrap_plots() +
  plot_layout(guides = "collect") &
  theme(legend.position = "bottom")

user_129938610
Related