在 R ggplot 的每个方面生成一个插图，同时保留原始方面内容的颜色

Question

我想生成一个图形，将图形的四个方面与每个方面的插图相结合，显示各自情节的细节。这是我尝试过的事情之一：

    #create data frame

n_replicates <- c(rep(1:10,15),rep(seq(10,100,10),15),rep(seq(100,1000,100),15),rep(seq(1000,10000,1000),15))
sim_years <- rep(sort(rep((1:15),10)),4)
sd_data <- rep (NA,600)
for (i in 1:600) {
sd_data[i]<-rnorm(1,mean=exp(0.1 * sim_years[i]), sd= 1/n_replicates[i])
}
max_rep <- sort(rep(c(10,100,1000,10000),150))
data_frame <- cbind.data.frame(n_replicates,sim_years,sd_data,max_rep)


#do first basic plot
library(ggplot2)
plot1<-ggplot(data=data_frame, aes(x=sim_years,y=sd_data,group =n_replicates, col=n_replicates)) + 
  geom_line() + theme_bw() +
  labs(title ="",  x = "year", y = "sd")
plot1


#make four facets
my_breaks = c(2, 10, 100, 1000, 10000)
facet_names <- c(
  `10` = "2, 3, ..., 10 replicates",
  `100` = "10, 20, ..., 100 replicates",
  `1000` = "100, 200, ..., 1000 replicates",
  `10000` = "1000, 2000, ..., 10000 replicates"
)
plot2 <- plot1 + 
  facet_wrap( ~ max_rep, ncol=2, labeller = as_labeller(facet_names)) + 
  scale_colour_gradientn(name = "number of replicates", trans = "log",
                         breaks = my_breaks, labels = my_breaks, colours = rainbow(20))
plot2


#extract inlays (this is where it goes wrong I think)
library(ggpmisc)
library(tibble)
library(dplyr)
inset <- tibble(x = 0.01, y = 10.01,
                    plot = list(plot2 +
                                  facet_wrap( ~ max_rep, ncol=2, labeller = as_labeller(facet_names)) +
                                  coord_cartesian(xlim = c(13, 15),
                                                  ylim = c(3, 5)) +
                                  labs(x = NULL, y = NULL, color = NULL) +
                                  scale_colour_gradient(guide = FALSE) + 
                                  theme_bw(10)))

plot3 <- plot2 +
  expand_limits(x = 0, y = 0) +
  geom_plot_npc(data = inset, aes(npcx = x, npcy = y, label = plot)) + 
  annotate(geom = "rect", 
           xmin = 13, xmax = 15, ymin = 3, ymax = 5,
           linetype = "dotted", fill = NA, colour = "black") 

plot3

这导致下图：

如您所见，插图中的颜色是错误的，所有四种颜色都出现在每个面中，尽管我当然只想要相应的插图。我在这里阅读了很多问题（甚至让我走到这一步）以及 ggpmisc 用户指南中的一些示例，但不幸的是，我仍然对如何实现我想要的东西有些迷茫。除了可能通过手动提取四个插图然后将它们与 plot2 组合来完成。但我希望有更好的方法来做到这一点。感谢您的帮助！

编辑：由于，现在更好的图形，但问题仍然部分未解决：

以下代码可以很好地嵌入，但不幸的是颜色没有保留。在上面的版本中，每个插图都重新使用自己的彩虹色，而不是从它所属的方面继承部分彩虹色阶。有谁知道为什么以及如何改变这个？在评论中，我进行了另一个（错误的）尝试来解决这个问题，它保留了颜色，但存在将所有四个插图放在每个方面的问题。

library(ggpmisc)
library(tibble)
library(dplyr)

# #extract inlays: good colours, but produces four insets.
# fourinsets <- tibble(#x = 0.01, y = 10.01,
#                      x = c(rep(0.01, 4)), 
#                      y = c(rep(10.01, 4)), 
#                     plot = list(plot2 +
#                                   facet_wrap( ~ max_rep, ncol=2) +
#                                   coord_cartesian(xlim = c(13, 15),
#                                                   ylim = c(3, 5)) +
#                                   labs(x = NULL, y = NULL, color = NULL) +
#                                   scale_colour_gradientn(name = "number of replicates", trans = "log", guide = FALSE,
#                                                          colours = rainbow(20)) +
#                                   theme(
#                                     strip.background = element_blank(),
#                                     strip.text.x = element_blank()
#                                   )
#                                 ))
# fourinsets$plot

library(purrr)
pp <- map(unique(data_frame$max_rep), function(x) {
  
  plot2$data <- plot2$data %>% filter(max_rep == x)
  plot2 + 
    coord_cartesian(xlim = c(12, 14),
                    ylim = c(3, 4)) +
    labs(x = NULL, y = NULL) +
    theme(
      strip.background = element_blank(),
      strip.text.x = element_blank(),
      legend.position = "none",
      axis.text=element_blank(),
      axis.ticks=element_blank()
    )
})
#pp[[2]]

inset_new <- tibble(x = c(rep(0.01, 4)), 
                    y = c(rep(10.01, 4)), 
                plot = pp, 
                max_rep = unique(data_frame$max_rep))

final_plot <- plot2 + 
  geom_plot_npc(data = inset_new, aes(npcx = x, npcy = y, label = plot, vp.width = 0.3, vp.height =0.6)) +
  annotate(geom = "rect", 
           xmin = 12, xmax = 14, ymin = 3, ymax = 4,
           linetype = "dotted", fill = NA, colour = "black") 


#final_plot

final_plot 然后看起来像这样：

我希望这能稍微澄清问题。非常欢迎任何想法:)

Answer 1

我认为这可以帮助您入门，尽管很难正确调整插图的大小（当您包含图例时）。

#set up data
library(ggpmisc)
library(tibble)
library(dplyr)
library(ggplot2)

# create data frame
n_replicates <- c(rep(1:10, 15), rep(seq(10, 100, 10), 15), rep(seq(100, 
  1000, 100), 15), rep(seq(1000, 10000, 1000), 15))
sim_years <- rep(sort(rep((1:15), 10)), 4)
sd_data <- rep(NA, 600)
for (i in 1:600) {
  sd_data[i] <- rnorm(1, mean = exp(0.1 * sim_years[i]), sd = 1/n_replicates[i])
}
max_rep <- sort(rep(c(10, 100, 1000, 10000), 150))
data_frame <- cbind.data.frame(n_replicates, sim_years, sd_data, max_rep)

# make four facets
my_breaks = c(2, 10, 100, 1000, 10000)
facet_names <- c(`10` = "2, 3, ..., 10 replicates", `100` = "10, 20, ..., 100 replicates", 
  `1000` = "100, 200, ..., 1000 replicates", `10000` = "1000, 2000, ..., 10000 replicates")

获取整体剧情：

# overall facet plot
overall_plot <- ggplot(data = data_frame, aes(x = sim_years, y = sd_data, group = n_replicates, col = n_replicates)) + 
  geom_line() + 
  theme_bw() + 
  labs(title = "", x = "year", y = "sd") + 
  facet_wrap(~max_rep, ncol = 2, labeller = as_labeller(facet_names)) + 
  scale_colour_gradientn(name = "number of replicates", trans = "log", breaks = my_breaks, labels = my_breaks, colours = rainbow(20))

#plot
overall_plot

给出：

然后从整体情节中提取每个情节，请参见。我们可以 map 遍历列表，一次提取一个：

pp <- map(unique(data_frame$max_rep), function(x) {
  
  overall_plot$data <- overall_plot$data %>% filter(max_rep == x)
  overall_plot + # coord_cartesian(xlim = c(13, 15), ylim = c(3, 5)) +
  labs(x = NULL, y = NULL) + 
  theme_bw(10) + 
  theme(legend.position = "none")
  
})

如果我们看其中一个（我已经删除了图例）例如

pp[[1]]
#pp[[2]]
#pp[[3]]
#pp[[4]]

给出：

然后我们想将这些插图添加到数据框中，以便每个图都有自己的行：

inset <- tibble(x = c(rep(0.01, 4)), 
                y = c(rep(10.01, 4)), 
                plot = pp, 
                max_rep = unique(data_frame$max_rep))

然后将其合并到整体情节中：

overall_plot + 
  expand_limits(x = 0, y = 0) + 
  geom_plot_npc(data = inset, aes(npcx = x, npcy = y, label = plot, vp.width = 0.8, vp.height = 0.8))

给出：

Answer 2

正在修改@user63230的优秀回答：

pp <- map(unique(data_frame$max_rep), function(x) {  
  plot2 + 
    aes(alpha = ifelse(max_rep == x, 1, 0)) +
    coord_cartesian(xlim = c(12, 14),
                    ylim = c(3, 4)) +
    labs(x = NULL, y = NULL) +
    scale_alpha_identity() +
    facet_null() +
    theme(
      strip.background = element_blank(),
      strip.text.x = element_blank(),
      legend.position = "none",
      axis.text=element_blank(),
      axis.ticks=element_blank()
    )
})

解释：

我们没有过滤传递给 plot2 的数据（这会影响颜色的映射），而是采用了一种新的审美方式alpha，其中属于其他重复数字的线被分配为 0 以表示透明度；
使用 scale_alpha_identity() 告诉 ggplot alpha 映射将按原样使用：即 1 表示 100%，0 表示 0%。
添加 facet_null() 以覆盖 plot2 的现有 facet_wrap，这会删除插图的小平面。

问题中的代码与其他所有内容都没有变化。

Answer 3

这是基于 Z.Lin 的回答的解决方案，但使用 ggforce::facet_wrap_paginate() 进行过滤并保持色标一致。

首先，我们可以制作 'root' 图，其中包含没有小平面的所有数据。

library(ggpmisc)
library(tibble)
library(dplyr)

n_replicates <- c(rep(1:10,15),rep(seq(10,100,10),15),rep(seq(100,1000,100),15),rep(seq(1000,10000,1000),15))
sim_years <- rep(sort(rep((1:15),10)),4)
sd_data <- rep (NA,600)
for (i in 1:600) {
  sd_data[i]<-rnorm(1,mean=exp(0.1 * sim_years[i]), sd= 1/n_replicates[i])
}
max_rep <- sort(rep(c(10,100,1000,10000),150))
data_frame <- cbind.data.frame(n_replicates,sim_years,sd_data,max_rep)


my_breaks = c(2, 10, 100, 1000, 10000)
facet_names <- c(
  `10` = "2, 3, ..., 10 replicates",
  `100` = "10, 20, ..., 100 replicates",
  `1000` = "100, 200, ..., 1000 replicates",
  `10000` = "1000, 2000, ..., 10000 replicates"
)

base <- ggplot(data=data_frame, 
                aes(x=sim_years,y=sd_data,group =n_replicates, col=n_replicates)) + 
  geom_line() + 
  theme_bw() +
  scale_colour_gradientn(
    name = "number of replicates",
    trans = "log10", breaks = my_breaks,
    labels = my_breaks, colours = rainbow(20)
  ) +
  labs(title ="",  x = "year", y = "sd")

接下来，主图将只是 facet_wrap() 的根图。

main <- base + facet_wrap(~ max_rep, ncol = 2, labeller = as_labeller(facet_names))

然后新的部分是使用 facet_wrap_paginate 与 nrow = 1 和 ncol = 1 用于每个 max_rep，我们将用作插图。好的是，这会进行过滤，并使色标与根图保持一致。

nmax_rep <- length(unique(data_frame$max_rep))

insets <- lapply(seq_len(nmax_rep), function(i) {
  base + ggforce::facet_wrap_paginate(~ max_rep, nrow = 1, ncol = 1, page = i) +
    coord_cartesian(xlim = c(12, 14), ylim = c(3, 4)) +
    guides(colour = "none", x = "none", y = "none") +
    theme(strip.background = element_blank(),
          strip.text = element_blank(),
          axis.title = element_blank(),
          plot.background = element_blank())
})
insets <- tibble(x = rep(0.01, nmax_rep),
                 y = rep(10.01, nmax_rep),
                 plot = insets,
                 max_rep = unique(data_frame$max_rep))

main +
  geom_plot_npc(data = insets, 
                aes(npcx = x, npcy = y, label = plot,
                    vp.width = 0.3, vp.height = 0.6)) +
  annotate(geom = "rect", 
           xmin = 12, xmax = 14, ymin = 3, ymax = 4,
           linetype = "dotted", fill = NA, colour = "black")

^{由 reprex package (v0.3.0)}

于 2020-12-15 创建

在 R ggplot 的每个方面生成一个插图，同时保留原始方面内容的颜色

Produce an inset in each facet of an R ggplot while preserving colours of the original facet content

r

ggplot2

ggpmisc