在使用相同 facet 数据的情况下，向每个 facet_wrap 添加一个子图。

Question

我尝试在每个faceted_wrap图形的partial geom_sf plot中添加直方图子图，使用与相应的facet_wrap图相同的数据。

我在谷歌上找到了一些方法，但目前还没有实质性进展。

我的先前尝试：

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

有什么方法可以实现这个目标吗？

- David Manske

Answer 1

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

- stefan

---

嗨，David。欢迎你。这是一个不错的问题，也是一个检查patchwork中新的inset_element函数的好机会。最好的祝福，S。 - stefan