使用相同的方面数据向每个 facet_wrap 添加子图

Adding a subplot to each facet_wrap using same facet data

我尝试根据与各自 facet_wrap 图中相同的数据,将直方图 suplots 添加到 facet_wrap 图中的每个部分 geom_sf 图中。

我通过 Google 找到了一些方法,但目前还没有具体的方法。

我之前的做法:

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))

知道我该如何实现吗?

Makung 使用 patchwork 包可以这样实现:

  1. 为每个组制作单独的图。为此,您可以将绘图代码包装在一个函数中,并使用例如循环遍历组lapply.

  2. 对于直方图,您可以使用 annotation_custom 继续您的方法,或者像我一样使用 patchwork::inset_element

  3. 将情节粘合在一起并收集指南。为此,为每个图中的填充比例设置相同的限制非常重要。

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")