Bar plot in ggplot, add horizontal subtitle

Question

Below you can find my code and the plot it produces. I want to add horizontal subtitles "Scenario1" and Scenario2" above, instead of having it together with "Sub-Scenario1" and "Sub-Scenario2". See the figure for more explanation.

myd<- data.frame( var1 = rep(c("Scenario1: Sub-Scenario 1","Scenario1: Sub-Scenario 2","Scenario2: Sub-Scenario 1","Scenario2: Sub-Scenario 2"),each=2), 
                     samp = rep(c("Outcome 1","Outcome 2"),4), 
                  V4=rep(NA,8),V3 = rep(NA,8), V2 = rep(NA,8), V1 = rep(NA,8) )

myd[myd$samp=="Outcome 1","V1"]=runif(4,100,200)
myd[myd$samp=="Outcome 1","V2"]=runif(4,100,200)
myd[myd$samp=="Outcome 1","V3"]=runif(4,100,200)
myd[myd$samp=="Outcome 1","V4"]=runif(4,100,200)
myd[myd$samp=="Outcome 2","V1"]=runif(4,100,200)
myd[myd$samp=="Outcome 2","V2"]=runif(4,100,200)
myd[myd$samp=="Outcome 2","V3"]=runif(4,100,200)
myd[myd$samp=="Outcome 2","V4"]=runif(4,100,200)

library(reshape2)
library(ggplot2)
meltd<- melt(myd, id.vars=1:2)

par(mfrow = c(1,1),lwd=2,oma=c(0,0.1,0,0))
m <- matrix(c(1,2),nrow = 2,ncol = 1,byrow = TRUE)
layout(mat = m,heights = c(0.85,0.15))

plot1<-ggplot(meltd, aes(x = var1, y = value, fill = variable, label = paste0(round(value, 1), "%"))) +
  geom_bar(stat = "identity", position = position_dodge(width = 0.8), width = 0.6) +
  facet_grid(samp ~ ., switch = "y", scales = "free_y", space = "free",labeller=label_wrap_gen(width=25, multi_line=T)) +
  coord_flip() +
  scale_fill_manual("legend",values = c("V4"="violet","V3" = "orange", "V2" = "red", "V1" = "blue", "Baseline" = "black")) +
  geom_text(aes(y = value + 20 * sign(value)), position = position_dodge(width = 0.8), size=4)+
  theme_bw() +
  theme(
    legend.position = "none",
    strip.placement = "outside",
    #axis.title.x = element_blank(),
    axis.title.y = element_blank(),
    # added face and size arguments
    axis.text.y = element_text(colour="black", size=12),
    axis.text.x= element_text(size=13),
    strip.text.y = element_text(size = 10, colour = "black", face='bold'),
    plot.margin = margin(0.1, 0.1, 2, 0.1, "cm"))+
  ylab("Relative change in 2016 (in %)")

plot1

Answer 1

Here I used coord_cartesian to set the area of the plot, and turned clip off to plot the labels outside the panel.

myd<- data.frame( var1 = rep(c("Scenario1: Sub-Scenario 1","Scenario1: Sub-Scenario 2","Scenario2: Sub-Scenario 1","Scenario2: Sub-Scenario 2"),each=2), 
                  samp = rep(c("Outcome 1","Outcome 2"),4), 
                  V4=rep(NA,8),V3 = rep(NA,8), V2 = rep(NA,8), V1 = rep(NA,8) )

myd[myd$samp=="Outcome 1","V1"]=runif(4,100,200)
myd[myd$samp=="Outcome 1","V2"]=runif(4,100,200)
myd[myd$samp=="Outcome 1","V3"]=runif(4,100,200)
myd[myd$samp=="Outcome 1","V4"]=runif(4,100,200)
myd[myd$samp=="Outcome 2","V1"]=runif(4,100,200)
myd[myd$samp=="Outcome 2","V2"]=runif(4,100,200)
myd[myd$samp=="Outcome 2","V3"]=runif(4,100,200)
myd[myd$samp=="Outcome 2","V4"]=run[![enter image description here][1]][1]if(4,100,200)

library(reshape2)
library(ggplot2)
library(ggstance)
library(tidyverse)
meltd<- melt(myd, id.vars=1:2)
meltd %>% 
    separate(col = var1, 
             into = c("scenario", "subscenario"),
             remove = F, 
             sep = ":") %>% 
    mutate(subscenario = fct_rev(subscenario)) %>% 
    ggplot(aes(value, var1, 
               fill = variable, 
               label = paste0(round(value, 1), "%"))) +
    geom_barh(stat = "identity", 
              position = position_dodgev()) + 
    theme_bw() +
    facet_grid(samp  ~ ., switch = "y", 
               scales = "free_y", space="free", 
               labeller = label_bquote(rows = .(samp))) +
    theme(legend.position = "none",
          strip.placement = "outside") +
    scale_y_discrete(NULL, 
                     labels = rep(c("Subscenario 1", "Subscenario 2"), 2)) +
    xlab("Relative change in 2016 (in %)") +
    coord_cartesian(xlim = c(0,200), clip = "off") + 
    geom_text(data = data.frame(
        x = -15, 
        y = rep(c(2.5,4.5), ,2), 
        scenario = rep(c("Scenario1", "Scenario2"), 2)), 
        inherit.aes = F, aes(x,y, label = scenario), 
        hjust = 1)

Answer 2

Just need to add a line break in your initial setup, using \n, like this:

myd<- data.frame( var1 = rep(c("Scenario1: \nSub-Scenario 1","Scenario1: \nSub-Scenario 2","Scenario2: \nSub-Scenario 1","Scenario2: \nSub-Scenario 2"),each=2), 
              samp = rep(c("Outcome 1","Outcome 2"),4), 
              V4=rep(NA,8),V3 = rep(NA,8), V2 = rep(NA,8), V1 = rep(NA,8) )

Output: