r - 在 R 中使用 ggplot() 时编写手动图例

Question

我有以下情节 p :

我希望图例看起来像另一个情节:

因为 p是两个不同图的组合 p1和 p2 ， 我用了:

p<- grid.arrange(p1, p2, ncol = 3, widths = c(3,5,0))

并且只保留了 p2 的图例(不包括“衣领 ID”=41365´，这是我想要的广告)

因此，我认为最简单的方法是手动创建图例。如果需要，我使用下面的脚本创建 p :

df1 <- tibble::tribble(~Proportion, ~Lower,~Upper, ~Time,~Collar,
                      0.242, 0.173, 0.329, "Day","41361´",
                      0.216, 0.152, 0.296, "Night","41361´")


df2 <- tibble::tribble(~Proportion, ~Lower,~Upper, ~Time,~Collar,
                      0.290, 0.214, 0.381, "Day","41366´",
                      0.256, 0.186, 0.342, "Night","41366´")


df<-rbind(df1,df2)

dfnew <- df %>% 
  mutate(ymin = Proportion - Lower,
         ymax = Proportion + Upper,
         linegroup = paste(Time, Collar))

set.seed(2)

myjit <- ggproto("fixJitter", PositionDodge,
                 width = 0.6,
                 dodge.width = 0,
                 jit = NULL,
                 compute_panel =  function (self, data, params, scales) 
                 {

                   #Generate Jitter if not yet
                   if(is.null(self$jit) ) {
                     self$jit <-jitter(rep(0, nrow(data)), amount=self$dodge.width)
                   }

                   data <- ggproto_parent(PositionDodge, self)$compute_panel(data, params, scales)

                   data$x <- data$x + self$jit
                   #For proper error extensions
                   if("xmin" %in% colnames(data)) data$xmin <- data$xmin + self$jit
                   if("xmax" %in% colnames(data)) data$xmax <- data$xmax + self$jit
                   data
                 } )


p1<-ggplot(data = dfnew, aes(x = Time, y = Proportion, group=linegroup)) +
  geom_point(aes(shape = as.character(Collar)), size = 4, stroke = 0, 
             position = myjit)+
  geom_line(aes(group = linegroup),linetype = "dotted",size=1, position = myjit) +
  theme(axis.text=element_text(size=15),
        axis.title=element_text(size=20)) +
  geom_errorbar(aes(ymin = Lower, ymax = Upper), width=0.3, size=1,
                position = myjit) + scale_shape_manual(values=c("41361´"=19,"41366´"=15)) +
  scale_color_manual(values = c("Day" = "black", 
                                "Night" = "black")) + labs(shape="Collar ID") + ylim(0.05, 0.4) + theme(legend.position = "none")

p1

df1 <- tibble::tribble(~Proportion, ~Lower,~Upper, ~Area,~Collar,
                      0.181, 0.148, 0.219, "LGCA","41361´",
                      0.289, 0.242 ,0.341 , "SNP","41361´")

df2 <- tibble::tribble(~Proportion, ~Lower,~Upper, ~Area,~Collar,
                      0.099, 0.096, 0.104, "LGCA","41365´",
                      0.224, 0.217 ,0.232 , "SNP","41365´")

df<-rbind(df1,df2)



dfnew <- df %>% 
  mutate(ymin = Proportion - Lower,
         ymax = Proportion + Upper,
         linegroup = paste(Area, Collar))

set.seed(2)

myjit <- ggproto("fixJitter", PositionDodge,
                 width = 0.6,
                 dodge.width = 0,
                 jit = NULL,
                 compute_panel =  function (self, data, params, scales) 
                 {

                   #Generate Jitter if not yet
                   if(is.null(self$jit) ) {
                     self$jit <-jitter(rep(0, nrow(data)), amount=self$dodge.width)
                   }

                   data <- ggproto_parent(PositionDodge, self)$compute_panel(data, params, scales)

                   data$x <- data$x + self$jit
                   #For proper error extensions
                   if("xmin" %in% colnames(data)) data$xmin <- data$xmin + self$jit
                   if("xmax" %in% colnames(data)) data$xmax <- data$xmax + self$jit
                   data
                 } )



p2<-ggplot(data = dfnew, aes(x = Area, y = Proportion, group=linegroup)) +
  geom_point(aes(shape = as.character(Collar)), size = 4, stroke = 0, 
             position = myjit)+
  geom_line(aes(group = linegroup),linetype = "dotted",size=1, position = myjit) +
  theme(axis.text=element_text(size=15),
        axis.title=element_text(size=20)) +
  geom_errorbar(aes(ymin = Lower, ymax = Upper), width=0.3, size=1,
                position = myjit) + scale_shape_manual(values=c("41361´"=19,"41365´"=17)) + scale_size_manual(values=c(2,2)) +
  scale_color_manual(values = c("SNP" = "black", 
                                "LGCA" = "black")) + labs(shape="Collar ID") + ylim(0.05, 0.4) +
  theme(legend.text=element_text(size=18))+
  theme(legend.title = element_text(size=18))

#+ theme(legend.position = "none")


p2


p<- grid.arrange(p1, p2, ncol = 3, widths = c(3,5,0))

请让我知道是否有更好的解决方案。任何帮助表示赞赏!

Answer 1

这里有两种方法可以避免所有 ggproto东西。我正在简化一些数据创建，制作一个数据框 by_time和一个 by_area ，因此您可以同时使用它们。我正在添加一个步骤来制作 Collar每个数据框的一个因子，我将用于第二种方法。

library(dplyr)
library(ggplot2)
library(tidyr)

by_time <- tibble::tribble(
  ~Proportion, ~Lower,~Upper, ~Time,~Collar,
  0.242, 0.173, 0.329, "Day","41361´",
  0.216, 0.152, 0.296, "Night","41361´",
  0.290, 0.214, 0.381, "Day","41366´",
  0.256, 0.186, 0.342, "Night","41366´"
) %>% 
  mutate(ymin = Proportion - Lower,
         ymax = Proportion + Upper,
         linegroup = paste(Time, Collar),
         Collar = as.factor(Collar))

by_area <- tibble::tribble(
  ~Proportion, ~Lower,~Upper, ~Area,~Collar,
  0.181, 0.148, 0.219, "LGCA","41361´",
  0.289, 0.242 ,0.341 , "SNP","41361´",
  0.099, 0.096, 0.104, "LGCA","41365´",
  0.224, 0.217 ,0.232 , "SNP","41365´"
) %>% 
  mutate(ymin = Proportion - Lower,
         ymax = Proportion + Upper,
         linegroup = paste(Area, Collar),
         Collar = as.factor(Collar))

第一种方法是将数据框一起操作成一个形状，您可以在其中使用分面。将每个数据框制作成一个长形状，其中标记它们的关键是您将用于分面的时间或区域。我将时间切换到第一级，所以它看起来更像你的。

##### with facets

df_long <- bind_rows(
  by_time %>% gather(key, value, Time),
  by_area %>% gather(key, value, Area)
) %>%
  mutate(key = forcats::fct_relevel(as.factor(key), "Time"))

head(df_long)
#> # A tibble: 6 x 9
#>   Proportion Lower Upper Collar   ymin  ymax linegroup    key   value
#>        <dbl> <dbl> <dbl> <chr>   <dbl> <dbl> <chr>        <fct> <chr>
#> 1      0.242 0.173 0.329 41361´ 0.069  0.571 Day 41361´   Time  Day  
#> 2      0.216 0.152 0.296 41361´ 0.064  0.512 Night 41361´ Time  Night
#> 3      0.290 0.214 0.381 41366´ 0.0760 0.671 Day 41366´   Time  Day  
#> 4      0.256 0.186 0.342 41366´ 0.07   0.598 Night 41366´ Time  Night
#> 5      0.181 0.148 0.219 41361´ 0.033  0.4   LGCA 41361´  Area  LGCA 
#> 6      0.289 0.242 0.341 41361´ 0.0470 0.63  SNP 41361´   Area  SNP

然后添加一些选项，使分面图看起来更像您想要的，将分面条放在底部看起来像轴标题。

ggplot(df_long, aes(x = value, y = Proportion, group = linegroup)) +
  geom_point(aes(shape = Collar), position = position_dodge(width = 0.4)) +
  geom_errorbar(aes(ymin = Lower, ymax = Upper), position = position_dodge(width = 0.4), width = 0.2) +
  facet_wrap(vars(key), scales = "free_x", strip.position = "bottom") +
  labs(x = NULL) +
  theme(strip.placement = "outside",
        strip.background = element_blank())

如果出于某种原因对您不起作用，则第二种方法是制作 2 个图并用 cowplot::plot_grid 排列它们。 .您还可以使用其他一些软件包( patchwork 是另一个我喜欢的软件包)。这里的技巧是为一个包含所有因子水平的图制作一个图例；我会用 forcats::fct_expand 来做这件事, 将一个数据框的级别添加到另一个。由于面积图将在右侧，这就是我调整因子水平并制作图例的地方。套装 drop = F在比例中，因此图例显示所有级别，即使它们不存在于数据中。

##### with plot_grid

p_time <- ggplot(by_time, aes(x = Time, y = Proportion, group = linegroup)) +
  geom_point(aes(shape = Collar), position = position_dodge(width = 0.4)) +
  geom_errorbar(aes(ymin = Lower, ymax = Upper), position = position_dodge(width = 0.4), width = 0.2) +
  scale_y_continuous(limits = c(0, 0.6))

p_area <- by_area %>%
  mutate(Collar = forcats::fct_expand(as.factor(Collar), levels(by_time$Collar))) %>%
  ggplot(aes(x = Area, y = Proportion, group = linegroup)) +
  geom_point(aes(shape = Collar), position = position_dodge(width = 0.4)) +
  geom_errorbar(aes(ymin = Lower, ymax = Upper), position = position_dodge(width = 0.4), width = 0.2) +
  scale_y_continuous(limits = c(0, 0.6)) +
  scale_shape_discrete(drop = F)

我还设置了 y 轴限制以匹配两个图 - 根据需要进行调整。

然后提取图例，并将所有内容放在 cowplot::plot_grid 中。 ，从单个图中删除图例。这样做的原因是您可以让两个图具有相同的大小，而不必为图例腾出空间。

legend <- cowplot::get_legend(p_area)

cowplot::plot_grid(
  p_time + theme(legend.position = "none"), 
  p_area + theme(legend.position = "none"),
  legend,
  nrow = 1,
  rel_widths = c(1, 1, 0.4)
)