ggplot2 - customize two-factor legend

Question

I am using ggplot2 to plot monthly vertical profiles of soil moisture in two sites, for both observed and modeled data.

I am using interaction to add colours to both factors (month and type). I am also creating two different manual color palettes with the colors I need. This is how to to reproduce the plot:

library(ggplot2)

df1<- structure(list(site = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 
10L, 10L, 10L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 10L, 10L, 10L, 10L, 
10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 
10L, 10L, 10L, 10L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 10L, 10L, 10L, 
10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 
10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 
10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 
10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 
10L, 10L, 10L, 10L, 10L), .Label = c("IL_Shabbona_5_NNE", "ME_Limestone_4_NNW", 
"ME_Old_Town_2_W", "MI_Chatham_1_SE", "MI_Gaylord_9_SSW", "MN_Goodridge_12_NNW", 
"MN_Sandstone_6_W", "NY_Ithaca_13_E", "NY_Millbrook_3_W", "WI_Necedah_5_WNW"
), class = "factor"), month = c(1L, 2L, 3L, 4L, 5L, 6L, 7L, 8L, 
9L, 10L, 11L, 12L, 1L, 2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L, 10L, 11L, 
12L, 1L, 2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L, 10L, 11L, 12L, 1L, 2L, 
3L, 4L, 5L, 6L, 7L, 8L, 9L, 10L, 11L, 12L, 1L, 2L, 3L, 4L, 5L, 
6L, 7L, 8L, 9L, 10L, 11L, 12L, 1L, 2L, 3L, 4L, 5L, 6L, 7L, 8L, 
9L, 10L, 11L, 12L, 1L, 2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L, 10L, 11L, 
12L, 1L, 2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L, 10L, 11L, 12L, 1L, 2L, 
3L, 4L, 5L, 6L, 7L, 8L, 9L, 10L, 11L, 12L, 1L, 2L, 3L, 4L, 5L, 
6L, 7L, 8L, 9L, 10L, 11L, 12L, 1L, 2L, 3L, 4L, 5L, 6L, 7L, 8L, 
9L, 10L, 11L, 12L, 1L, 2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L, 10L, 11L, 
12L, 1L, 2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L, 10L, 11L, 12L, 1L, 2L, 
3L, 4L, 5L, 6L, 7L, 8L, 9L, 10L, 11L, 12L, 1L, 2L, 3L, 4L, 5L, 
6L, 7L, 8L, 9L, 10L, 11L, 12L, 1L, 2L, 3L, 4L, 5L, 6L, 7L, 8L, 
9L, 10L, 11L, 12L, 1L, 2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L, 10L, 11L, 
12L, 1L, 2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L, 10L, 11L, 12L, 1L, 2L, 
3L, 4L, 5L, 6L, 7L, 8L, 9L, 10L, 11L, 12L, 1L, 2L, 3L, 4L, 5L, 
6L, 7L, 8L, 9L, 10L, 11L, 12L), depth = c(5, 5, 5, 5, 5, 5, 5, 
5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 10, 10, 10, 
10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 
10, 10, 10, 10, 10, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 
20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 50, 50, 50, 
50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 
50, 50, 50, 50, 50, 100, 100, 100, 100, 100, 100, 100, 100, 100, 
100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 
100, 100, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 10, 10, 10, 10, 
10, 10, 10, 10, 10, 10, 10, 10, 20, 20, 20, 20, 20, 20, 20, 20, 
20, 20, 20, 20, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 
100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 5, 
5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 10, 10, 10, 10, 10, 10, 10, 
10, 10, 10, 10, 10, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 
20, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 100, 100, 
100, 100, 100, 100, 100, 100, 100, 100, 100, 100), value = c(0.38, 
0.4, 0.37, 0.32, 0.29, 0.3, 0.24, 0.28, 0.24, 0.26, 0.32, 0.39, 
0.13, NaN, 0.13, 0.12, 0.1, 0.1, 0.06, 0.07, 0.09, 0.1, 0.12, 
0.13, 0.39, 0.39, 0.37, 0.35, 0.33, 0.31, 0.27, 0.29, 0.27, 0.28, 
0.34, 0.38, 0.1, NaN, 0.12, 0.11, 0.09, 0.09, 0.05, 0.06, 0.09, 
0.09, 0.11, 0.11, 0.39, 0.41, 0.38, 0.35, 0.34, 0.32, 0.29, 0.33, 
0.31, 0.3, 0.34, 0.36, 0.1, NaN, 0.1, 0.1, 0.09, 0.08, 0.05, 
0.05, 0.08, 0.08, 0.1, 0.1, 0.32, 0.31, 0.33, 0.34, 0.36, 0.34, 
0.29, 0.33, 0.32, 0.31, 0.32, 0.33, 0.06, 0.06, 0.07, 0.06, 0.06, 
0.05, 0.03, 0.03, 0.04, 0.05, 0.06, 0.06, 0.4, 0.4, 0.41, 0.41, 
0.45, 0.47, 0.43, 0.4, 0.39, 0.38, 0.38, 0.4, 0.05, 0.05, 0.05, 
0.06, 0.05, 0.05, 0.04, 0.04, 0.05, 0.05, 0.06, 0.05, 0.35, 0.35, 
0.36, 0.33, 0.29, 0.28, 0.27, 0.26, 0.26, 0.28, 0.3, 0.36, 0.35, 
0.35, 0.36, 0.33, 0.29, 0.28, 0.27, 0.27, 0.27, 0.28, 0.3, 0.35, 
0.34, 0.35, 0.35, 0.34, 0.3, 0.29, 0.28, 0.28, 0.28, 0.29, 0.3, 
0.34, 0.28, 0.29, 0.3, 0.32, 0.31, 0.3, 0.29, 0.29, 0.29, 0.3, 
0.3, 0.29, 0.26, 0.27, 0.27, 0.29, 0.29, 0.29, 0.28, 0.28, 0.28, 
0.29, 0.29, 0.28, 0.38, 0.38, 0.39, 0.38, 0.31, 0.3, 0.29, 0.29, 
0.3, 0.31, 0.35, 0.39, 0.36, 0.36, 0.37, 0.37, 0.31, 0.31, 0.29, 
0.3, 0.3, 0.31, 0.33, 0.37, 0.37, 0.37, 0.37, 0.38, 0.32, 0.32, 
0.31, 0.31, 0.31, 0.32, 0.33, 0.37, 0.31, 0.32, 0.32, 0.34, 0.33, 
0.32, 0.31, 0.31, 0.32, 0.32, 0.31, 0.3, 0.27, 0.28, 0.28, 0.29, 
0.31, 0.3, 0.3, 0.29, 0.3, 0.3, 0.3, 0.28), type = rep(c("observed","modeled"), each=120)), class = "data.frame", row.names = c(NA, 
-240L))

# Create blue and red palettes
mypal.blue <- colorRampPalette(RColorBrewer::brewer.pal(6,"PuBu"))
mypal.red  <- colorRampPalette(RColorBrewer::brewer.pal(6,"YlOrRd"))

# Plot
ggplot(df1, aes(x=value, y=-depth, colour=interaction(as.factor(month),type))) +
  geom_path(size=1) + geom_point(size=0.7) +
  facet_wrap(~ site, nrow=3) +
  theme_bw(base_size=20) +
  scale_colour_manual(values=c(mypal.blue(12),mypal.red(12))) +
  theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank()) + 
  theme(legend.title=element_blank()) + theme(legend.position = c(0.75, 0.13))

However, the legend is a complete mess.

I would like to create two separate legends, loosely based on this example.

• one showing orange for observed and blue for modeled
• the other one showing the actual color gradients and the months (ideally with the first letter instead of numbers)

How to create such legends?

Answer 1

Updated Answer

It just hit me that there is a relatively straightforward way to hack the legend to get pretty close to what you want. We relabel the legend labels and add a title. The hacky part is that you have to fiddle with the legend title spacing, legend key width, and text size to get the titles lined up over the legend keys.

With all those lines and colors and the complicated legend, the plot seems very busy and difficult to interpret beyond showing that the model doesn't fit the data very well, so maybe it would still be better to consider one of the other options in my or @neilfws's answer. In addition, because the legend title is manually hardcoded, it's not linked to the aesthetic mapping and you therefore have to be careful that "Modeled" and "Observed" are in the right order above the legend keys.

ggplot(df1, aes(x=value, y=-depth, colour=interaction(as.factor(month),type))) +
  geom_path(size=1) + geom_point(size=0.7) +
  facet_wrap(~ site, nrow=3) +
  theme_bw(base_size=20) +
  scale_colour_manual(values=c(mypal.blue(12),mypal.red(12)),
                      labels=rep(month.abb, 2)) +
  theme(panel.grid.major = element_blank(), 
        panel.grid.minor = element_blank(),
        legend.title=element_text(size=rel(0.6)),
        legend.text=element_text(size=rel(0.5)),
        legend.key.width=unit(1.1,"cm")) + 
  labs(colour="Modeled  Observed")

Original Answer

AFAIK, there's no way to generate two separate legends for a single aesthetic within the normal ggplot workflow. In this case, that means you can have only a single color legend. Probably you could hack two different color legends by manipulating the underlying ggplot grob structure.

Another option would be to use two different aesthetics. The example below uses linetype to distinguish modeled and observed, but it doesn't provide as much constrast as the two different color sets.

library(tidyverse)

ggplot(df1 %>% 
         mutate(month=factor(month.abb[month], levels=month.abb)), 
       aes(x=value, y=-depth, linetype=type, colour=month)) +
  geom_path(size=1) + geom_point(size=0.7) +
  facet_wrap(~ site, nrow=3) +
  theme_bw(base_size=20) +
  scale_colour_manual(values=mypal.red(12)) +
  theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank()) + 
  theme(legend.title=element_blank()) 

For reference, here's what your original code produces (minus the change in legend position):

Another option would be to facet by month in addition to type. This takes up more space, but makes it easier to see both the month trend and the difference between modeled and observed.

ggplot(df1 %>% 
         mutate(month=factor(month.abb[month], levels=month.abb)),
       aes(x=value, y=-depth, colour=type)) +
  geom_path(size=1) + geom_point(size=0.7) +
  facet_grid(month ~ site) +
  theme_classic() +
  theme(panel.background=element_rect(colour="grey50", fill=NA))

Answer 2

Looking at your data, it seems to me that what you want to visualize can be expressed something like this:

"How do observed values compare to modelled values at different depths, for each site, through time?"

So I would approach the chart differently: plot value versus month, color by type and use facets for site and depth.

library(tidyverse)
df1 %>% 
  mutate(Month = factor(month.abb[month], 
         levels = month.abb)) %>% 
  ggplot(aes(Month, value)) + 
    geom_point(aes(color = type)) + 
    facet_grid(depth~site) + 
    theme_bw()

It's now immediately apparent that the modeled values for site IL_Shabbona_5_NNE are closer to the observed, and more so at shallower depth.