custom legend ggplot2 / ggarrange

Question

I have a series of graphs where I have manually coloured different bars. I would like to create a (ideally shared) legend which refers to the colour of the bars. The bar colours are not a property of the graph aesthetic, so I am not sure how to do this manually.

Below is some example code

set.seed(1234)
id <- rep(1:50, each = 3)
stimuli <- rep(c("a", "b", "c"), each = 1, times = 50)
dv_1 <- rnorm(150, mean = 2, sd = 0.7)
dv_2 <- rnorm(150, mean = 4, sd = 1.5)
dv_3 <- rnorm(150, mean = 7.5, sd = 1)


simdat <- data.frame(id, stimuli, dv_1, dv_2, dv_3)

#Stimuli A
dat_stimuli_a <- subset(simdat, stimuli == "a")

melt_a <- melt(dat_stimuli_a, id.vars = "id", measure.vars = c("dv_1", "dv_2", "dv_3"))

pwc_a <- melt_a %>%
  wilcox_test(value ~ variable, paired = TRUE, p.adjust.method = "holm", detailed = TRUE) %>%
  slice(1:2)

pwc_a

gg_a <- ggplot(melt_a, aes(x = reorder(variable, value), y = value)) +
  stat_summary(fun = mean, geom = "bar", width = 0.75, aes(fill = variable)) +
  stat_summary(fun.data = mean_cl_boot, geom = "errorbar",
               colour="black", position=position_dodge(1), width=.2) + 
  stat_pvalue_manual(pwc_a, label = "p.adj.signif", tip.length = 0.02, step.increase = 0.05, hide.ns = TRUE, y.position = c(7, 8), label.size = 3) +
  ggtitle("Stimuli A") +
  theme(plot.title = element_text(size=10, hjust = 0.5, face = "bold")) +
  scale_y_continuous(breaks = seq(1,10,by = 1), labels = c("1", "2", "3", "4", "5", "6", "7", "8", "9", "10"), limits = c(-0, 10)) +
  theme(axis.text = element_text(size=10)) +
  theme(axis.title = element_text(size=10, face = "bold")) +
  theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.25))

gg_a <- gg_a + scale_fill_manual(values = c("#9E0142", "#FDAE61", "#FDAE61")) +
    theme(legend.position = "none")


#Stimuli B
dat_stimuli_b <- subset(simdat, stimuli == "b")

melt_b <- melt(dat_stimuli_b, id.vars = "id", measure.vars = c("dv_1", "dv_2", "dv_3"))

pwc_b <- melt_b %>%
  wilcox_test(value ~ variable, paired = TRUE, p.adjust.method = "holm", detailed = TRUE) %>%
  slice(1, 3)
pwc_b

gg_b <- ggplot(melt_b, aes(x = reorder(variable, value), y = value)) +
  stat_summary(fun = mean, geom = "bar", width = 0.75, aes(fill = variable)) +
  stat_summary(fun.data = mean_cl_boot, geom = "errorbar",
               colour="black", position=position_dodge(1), width=.2) + 
  stat_pvalue_manual(pwc_b, label = "p.adj.signif", tip.length = 0.02, step.increase = 0.05, hide.ns = TRUE, y.position = c(7, 8), label.size = 3) +
  ggtitle("Stimuli B") +
  theme(plot.title = element_text(size=10, hjust = 0.5, face = "bold")) +
  scale_y_continuous(breaks = seq(1,10,by = 1), labels = c("1", "2", "3", "4", "5", "6", "7", "8", "9", "10"), limits = c(-0, 10)) +
  theme(axis.text = element_text(size=10)) +
  theme(axis.title = element_text(size=10, face = "bold")) +
  theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.25))

gg_b <- gg_b + scale_fill_manual(values = c("#FDAE61", "#9E0142", "#FDAE61")) +
    theme(legend.position = "none")

#Stimuli C
dat_stimuli_c <- subset(simdat, stimuli == "c")

melt_c <- melt(dat_stimuli_c, id.vars = "id", measure.vars = c("dv_1", "dv_2", "dv_3"))

pwc_c <- melt_c %>%
  wilcox_test(value ~ variable, paired = TRUE, p.adjust.method = "holm", detailed = TRUE) %>%
  slice(2:3)
pwc_c

gg_c <- ggplot(melt_c, aes(x = reorder(variable, value), y = value)) +
  stat_summary(fun = mean, geom = "bar", width = 0.75, aes(fill = variable)) +
  stat_summary(fun.data = mean_cl_boot, geom = "errorbar",
               colour="black", position=position_dodge(1), width=.2) + 
  stat_pvalue_manual(pwc_c, label = "p.adj.signif", tip.length = 0.02, step.increase = 0.05, hide.ns = TRUE, y.position = c(8, 9), label.size = 3) +
  ggtitle("Stimuli C") +
  theme(plot.title = element_text(size=10, hjust = 0.5, face = "bold")) +
  scale_y_continuous(breaks = seq(1,10,by = 1), labels = c("1", "2", "3", "4", "5", "6", "7", "8", "9", "10"), limits = c(-0, 10)) +
  theme(axis.text = element_text(size=10)) +
  theme(axis.title = element_text(size=10, face = "bold")) +
  theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.25))

gg_c <- gg_c + scale_fill_manual(values = c("#FDAE61", "#FDAE61", "#9E0142")) +
    theme(legend.position = "none")

figure <- ggarrange(gg_a, gg_b, gg_c, ncol = 3, nrow = 1, align = "hv")

figure

I would like to add a legend which represents the two colours (red/orange) with their labels (eg red = "Label 1", orange = "Label 2". How can I do this?

Answer 1

This is far from pretty, but you need to map a separate variable to fill if you want the fill to be independent of the dv_# values.

Adjust labels as required.

The process would benefit from use of functions as there is so much repetition, but that is really separate issue.

library(ggplot2)
library(reshape2) #  melt
library(rstatix) #  wilcox_test
library(ggpubr) #  stat_pvalue_manual
library(dplyr) # slice

set.seed(1234)
id <- rep(1:50, each = 3)
stimuli <- rep(c("a", "b", "c"), each = 1, times = 50)
dv_1 <- rnorm(150, mean = 2, sd = 0.7)
dv_2 <- rnorm(150, mean = 4, sd = 1.5)
dv_3 <- rnorm(150, mean = 7.5, sd = 1)


simdat <- data.frame(id, stimuli, dv_1, dv_2, dv_3)

#Stimuli A
dat_stimuli_a <- subset(simdat, stimuli == "a")

melt_a <- melt(dat_stimuli_a, id.vars = "id", measure.vars = c("dv_1", "dv_2", "dv_3"))

pwc_a <- melt_a %>%
  wilcox_test(value ~ variable, paired = TRUE, p.adjust.method = "holm", detailed = TRUE) %>%
  slice(1:2)
# add label variable for simulation a
melt_a <- 
  melt_a %>% 
  mutate(label = if_else(variable == "dv_1", "label_1", "label_2"))

gg_a <- ggplot(melt_a, aes(x = reorder(variable, value), y = value)) +
  stat_summary(fun = mean, geom = "bar", width = 0.75, aes(fill = label)) +
  stat_summary(fun.data = mean_cl_boot, geom = "errorbar",
               colour="black", position=position_dodge(1), width=.2) + 
  stat_pvalue_manual(pwc_a, label = "p.adj.signif", tip.length = 0.02, step.increase = 0.05, hide.ns = TRUE, y.position = c(7, 8), label.size = 3) +
  ggtitle("Stimuli A") +
  theme(plot.title = element_text(size=10, hjust = 0.5, face = "bold")) +
  scale_y_continuous(breaks = seq(1,10,by = 1), labels = c("1", "2", "3", "4", "5", "6", "7", "8", "9", "10"), limits = c(-0, 10)) +
  theme(axis.text = element_text(size=10)) +
  theme(axis.title = element_text(size=10, face = "bold")) +
  theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.25))

gg_a <- gg_a + scale_fill_manual(values = c("label_1" = "#9E0142", "label_2" = "#FDAE61")) +
  theme(legend.position = "none")


#Stimuli B
dat_stimuli_b <- subset(simdat, stimuli == "b")

melt_b <- melt(dat_stimuli_b, id.vars = "id", measure.vars = c("dv_1", "dv_2", "dv_3"))

pwc_b <- melt_b %>%
  wilcox_test(value ~ variable, paired = TRUE, p.adjust.method = "holm", detailed = TRUE) %>%
  slice(1, 3)
# add label variable for simulation b
melt_b <- 
  melt_b %>% 
  mutate(label = if_else(variable == "dv_2", "label_1", "label_2"))

gg_b <- ggplot(melt_b, aes(x = reorder(variable, value), y = value)) +
  stat_summary(fun = mean, geom = "bar", width = 0.75, aes(fill = label)) +
  stat_summary(fun.data = mean_cl_boot, geom = "errorbar",
               colour="black", position=position_dodge(1), width=.2) + 
  stat_pvalue_manual(pwc_b, label = "p.adj.signif", tip.length = 0.02, step.increase = 0.05, hide.ns = TRUE, y.position = c(7, 8), label.size = 3) +
  ggtitle("Stimuli B") +
  theme(plot.title = element_text(size=10, hjust = 0.5, face = "bold")) +
  scale_y_continuous(breaks = seq(1,10,by = 1), labels = c("1", "2", "3", "4", "5", "6", "7", "8", "9", "10"), limits = c(-0, 10)) +
  theme(axis.text = element_text(size=10)) +
  theme(axis.title = element_text(size=10, face = "bold")) +
  theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.25))

gg_b <- gg_b + scale_fill_manual(values = c("label_1" = "#9E0142", "label_2" = "#FDAE61")) +
  theme(legend.position = "none")



ggarrange(gg_a, gg_b, ncol = 2, nrow = 1, align = "hv",
           common.legend = TRUE,
           legend = "bottom")
#> Warning: Removed 1 rows containing non-finite values (stat_summary).
#> Warning: Removed 1 rows containing non-finite values (stat_summary).

#> Warning: Removed 1 rows containing non-finite values (stat_summary).

#> Warning: Removed 1 rows containing non-finite values (stat_summary).

^{Created on 2021-11-25 by the reprex package (v2.0.1)}