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

Question

我尝试根据与相应 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))

知道如何实现吗？

Answer 1

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