Write a manual legend when using ggplot() in R

Question

I've the following plot p:

For which I would like the legend to look like this other plot:

Because p is a combination of two different plots p1 and p2, I used:

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

And only the legend for p2 was kept (which doesn't include "Collar ID"=41365´, which is what I would like to ad)

Hence, I thought the easiest was to create a legend manually. In case that is needed, I used the script below to create 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))

Please let me know if there's a better solution for this. Any help is appreciated!

+1 for putting so much work into solving this before posting, and for digging so deep into the `ggplot` innards. I think it's probably simpler than this, though: one thing you could do is make sure both data subsets, or at least the one you're using to make the legend, have all the factor levels you want to show. Then add `drop = F` to your scale(s) that create the legend — camille, Sep 10 '19 at 14:27
[Here's one post](https://stackoverflow.com/questions/13649473/add-a-common-legend-for-combined-ggplots?rq=1) that runs through some relevant options. I'd recommend `forcats` for unifying factor levels if necessary. There are also several packages that make it easier to arrange ggplots: cowplot, patchwork, ggpubr, egg (haven't personally used that one) — camille, Sep 10 '19 at 14:29

score 3 · Answer 1 · answered Sep 12 '19 at 13:58

Here are two ways I'd approach this that avoid all the ggproto stuff. I'm streamlining some of the data creation, making one data frame by_time and one by_area, so you have them both to work with together. I'm adding a step to make Collar a factor for each data frame, which I'll use for the second method.

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

First way is to manipulate the data frames together into a shape where you can just use facets. Make each data frame into a long shape, where the key marking them each off which you'll use for faceting is either Time or Area. I'm switching Time to the first level so it looks more like yours.

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

Then add a few options to make the facetted plot look more like what you want, putting the facet strips on the bottom to look like axis titles.

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

If for whatever reason that won't work for you, the second way is to make 2 plots and arrange them with cowplot::plot_grid. There are a few other packages that you could use instead (patchwork is another I like). The trick here is to make a legend for one plot that includes all factor levels; I'll do that with forcats::fct_expand, to add the levels of one data frame to the other. Since the Area plot will be on the right, that's where I'm adjusting factor levels and making the legend. Set drop = F in the scale so the legend shows all levels, even if they aren't present in the data.

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

I've also set the y-axis limits to match between the two plots—adjust that as needed.

Then extract the legend, and put everything together in cowplot::plot_grid, remove the legend from the individual plots. The reason for that is so you can have the two plots be the same size, without one having to make space for the legend.

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

This looks like a fantastic answer, and must have taken a fair bit of time to put together. Good work, camille! — halfer, Sep 17 '19 at 20:46

score 1 · Answer 2 · answered Sep 10 '19 at 15:09

If you are looking to add a legend with all 3 ids this is one approach. You can create the plots like you did then just use the function g_legend below to grab the legend with 3 ids. Then remove the legends from your plots and put the 3 objects (2 plots and the legend) into grid.arrange . I specified a layout_matrix to show that you can customize it further with how much space each object takes up.

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



p1<-ggplot(data = dfnew, aes(x = Time, y = Proportion, group=linegroup)) +
  geom_point(aes(shape = as.character(Collar)), size = 4, stroke = 0)+
  geom_line(aes(group = linegroup),linetype = "dotted",size=1) +
  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) +
  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")



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




p2<-ggplot(data = dfnew, aes(x = Area, y = Proportion, group=linegroup)) +
  geom_point(aes(shape = as.character(Collar)), size = 4, stroke = 0)+
  geom_line(aes(group = linegroup),linetype = "dotted",size=1) +
  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) + 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")


g_legend<-function(a.gplot){
  tmp <- ggplot_gtable(ggplot_build(a.gplot))
  leg <- which(sapply(tmp$grobs, function(x) x$name) == "guide-box")
  legend <- tmp$grobs[[leg]]
  return(legend)}
#put in plot with 3 ids in the g_legend function
aleg <- g_legend(p1)

p1 <- p1+ theme(legend.position = "none")
p2 <- p2+ theme(legend.position = "none")



lay <- rbind(c(1,1,2,2,3),
             c(1,1,2,2,3))


gridExtra::grid.arrange(p1, p2,
                        #use layout matrix to set sizes
                        layout_matrix=lay,
                        # add legend
                        aleg)

Write a manual legend when using ggplot() in R

2 Answers2