Annotation on only the first facet of ggplot in R? - r

I have the following code that produce a ggplot that has text (i.e., "calibration") on both facets. I want the text be appeared on the first facet only. I tried a few things but didn't succeed. Any help would be appreciated.
library(ggplot2)
library(lubridate)
set.seed(123)
DF1 <- data.frame(Date = seq(as.Date("2001-01-01"), to = as.Date("2005-12-31"), by = "1 month"),
Ob = runif(60,1,5), L95 =runif(60, 0,4), U95 = runif(60,2,7), Sim = runif(60,1,5),
Loc = rep("Upstream", 60))
DF2 <- data.frame(Date = seq(as.Date("2001-01-01"), to = as.Date("2005-12-31"), by = "1 month"),
Ob = runif(60,1,5), L95 =runif(60, 0,4), U95 = runif(60,2,7), Sim = runif(60,1,5),
Loc = rep("Downstream", 60))
DF <- dplyr::bind_rows(DF1,DF2)
DF$Loc <- factor(DF$Loc, levels = c("Upstream","Downstream"))
ggplot(DF, aes(x = Date))+
geom_ribbon(aes(ymin = L95, ymax = U95), fill = "grey30", alpha = 0.4)+
geom_line(aes(y = Ob, color = "blue"), size = 1 )+
geom_line(aes(y = Sim, color = "black"), size = 1, linetype = "dashed")+
geom_vline(xintercept = as.Date("2004-12-01"),color = "red", size = 1.30)+
facet_wrap(~ Loc, ncol = 1, scales = "free_y")+
theme_bw()+
annotate(geom = "text", x = as.Date("2002-01-01"), y = 4, label = "Calibration")

Try this trick:
library(ggplot2)
#Code
ggplot(DF, aes(x = Date))+
geom_ribbon(aes(ymin = L95, ymax = U95), fill = "grey30", alpha = 0.4)+
geom_line(aes(y = Ob, color = "blue"), size = 1 )+
geom_line(aes(y = Sim, color = "black"), size = 1, linetype = "dashed")+
geom_vline(xintercept = as.Date("2004-12-01"),color = "red", size = 1.30)+
facet_wrap(~ Loc, ncol = 1, scales = "free_y")+
theme_bw()+
geom_text(data=data.frame(Date=as.Date("2002-01-01"),y=4,
label = "Calibration",Loc='Upstream'),
aes(y=y,label=label))
Output:
You can also use Loc=unique(DF$Loc)[1] in the geom_text() side. It will produce same output.

Related

Legend for a plot with sec.axis (geom bar + geom line)

I have a ggplot with two y-axes by the sec.axis command, and I've been struggling with handling legends in these situations.
The code:
library(ggplot2)
library(ggrepel)
df <- data.frame(day = as.character(seq(from = 1, to = 100, by = 1)),
total = rbinom(n=100,30,0.5),
prop = runif(100))
df <- df %>% arrange(df, by = day)
df$`percentage` <- label_percent(accuracy = 0.01)(df$prop)
ggplot(data = df,
aes(x = day, y = total)) +
geom_bar(aes(x = day, y = total), stat = "identity", fill = "lightgreen", width = 0.35) +
geom_line(data = df,
aes(x = day, y = (prop)*15, group = 1, color = prop),
color = "red", size = 1,inherit.aes = TRUE) +
scale_y_continuous(
labels = function(x) format(x, scientific = FALSE),
#breaks = seq(from = 0, to = 10000000,by = 100000),
sec.axis = sec_axis(trans = ~./15,
name = "Secondary axis",
breaks = seq(from = 0, to = 10, by = 0.1),
scales::percent))+
theme(axis.text.x = element_text(angle = 90, vjust = 0.5))+
geom_label_repel(data=df[nrow(df),],
aes(x = day,
y = prop*15,
label = round(prop*100,2)),
color = 'red',
nudge_x = 2,
segment.alpha = 0.5) +
scale_x_discrete(expand = expansion(add = c(0, 7)))
And I wanted to simply have the legend, instead of having the axis description, like this:
I know it seems reasonably easy to obtain, but given the fact that I don’t have any groups, I either: can't plot any legend what so ever; or I get plotted two squares (when I wanted the legend to consist of a line, with the geom_line color and a square with the geom_bar color).
With the code #divibisan provided, I get the following output:
Final update:
I finally found the solution. I still have no idea how I got a different output from what #divibisan posted, but here goes what worked for me:
library(dplyr)
library(ggplot2)
library(ggrepel)
df <- data.frame(day = as.character(seq(from = 1, to = 100, by = 1)),
total = rbinom(n=100,30,0.5),
prop = runif(100))
df <- df %>% arrange(df, by = day)
df$`percentage` <- scales::label_percent(accuracy = 0.01)(df$prop)
ggplot(data = df,
aes(x = day, y = total)) +
geom_bar(aes(x = day, y = total, fill = "Total"), stat = "identity", width = 0.35) +
geom_line(data = df,
aes(x = day, y = (prop)*15, group = 1, color = 'Percentage'), size = 1,inherit.aes = TRUE) +
scale_y_continuous(
labels = function(x) format(x, scientific = FALSE),
#breaks = seq(from = 0, to = 10000000,by = 100000),
sec.axis = sec_axis(trans = ~./15,
name = "Secondary axis",
breaks = seq(from = 0, to = 10, by = 0.1),
scales::percent))+
theme(axis.text.x = element_text(angle = 90, vjust = 0.5))+
geom_label_repel(data=df[nrow(df),],
aes(x = day,
y = prop*15,
label = round(prop*100,2)),
color = 'red',
nudge_x = 2,
segment.alpha = 0.5) +
scale_x_discrete(expand = expansion(add = c(0, 7))) +
scale_fill_manual(values=c('Total' = 'lightgreen'), drop=TRUE, name='') +
scale_color_manual(values=c('Percentage' = "red"), drop=TRUE, name='') +
theme(legend.title = element_blank())
You just need to set the color/fill with a value in the aes, then use a scale function to set the color and create a legend. Here, we move the color= and fill= values from the bar and line into the aes. Then we add scale_fill/color_manual functions that set the color based on those names:
library(dplyr)
library(ggplot2)
library(ggrepel)
df <- data.frame(day = as.character(seq(from = 1, to = 100, by = 1)),
total = rbinom(n=100,30,0.5),
prop = runif(100))
df <- df %>% arrange(df, by = day)
df$`percentage` <- scales::label_percent(accuracy = 0.01)(df$prop)
ggplot(data = df,
aes(x = day, y = total)) +
geom_bar(aes(x = day, y = total, fill = "Total"), stat = "identity", width = 0.35) +
geom_line(data = df,
aes(x = day, y = (prop)*15, group = 1, color = 'Percentage'), size = 1,inherit.aes = TRUE) +
scale_y_continuous(
labels = function(x) format(x, scientific = FALSE),
#breaks = seq(from = 0, to = 10000000,by = 100000),
sec.axis = sec_axis(trans = ~./15,
name = "Secondary axis",
breaks = seq(from = 0, to = 10, by = 0.1),
scales::percent))+
theme(axis.text.x = element_text(angle = 90, vjust = 0.5))+
geom_label_repel(data=df[nrow(df),],
aes(x = day,
y = prop*15,
label = round(prop*100,2)),
color = 'red',
nudge_x = 2,
segment.alpha = 0.5) +
scale_x_discrete(expand = expansion(add = c(0, 7))) +
scale_fill_manual(values=c('Total' = 'lightgreen', 'Percentage'='red'), drop=TRUE, name='') +
scale_color_manual(values=c('Total' = 'lightgreen', 'Percentage'='red'), drop=TRUE, name='')
If, for some reason, the drop argument isn't working and both colors show up in both scales, there's really no reason to include them in the scale if they're not expected to be there. Just only include the colors in the scale that are desired:
scale_fill_manual(values=c('Total' = 'lightgreen'), drop=TRUE, name='') +
scale_color_manual(values=c('Percentage'='red'), drop=TRUE, name='')

ggplot2 scale_color_identity() how to change linestyle and design of the legend?

I coded the following ggplot. The problem is that the design of the legend is flawed: The elements of the legend are interconnected with what appears to be dashed lines. How can this be removed? And furthermore, navy should be a dashed line, but it is shown as a solid one. Is there a possibility to change that? This is my code:
plot1 <- ggplot() +
geom_line(aes(x = datacom$Datum , y = datacom$`CDU/CSU`, colour = "black"),size=0.8) +
geom_line(aes(x = datacom$Datum , y = datacom$SPD, colour = "red"),size=0.8) +
geom_line(aes(x = datacom$Datum , y = datacom$GRÜNE, col = "green"),size=0.8) +
geom_line(aes(x = datacom$Datum , y = datacom$FDP, col = "gold1"),size=0.8) +
geom_line(aes(x = datacom$Datum , y = datacom$`Linke/PDS`, col = "darkred"),size=0.8) +
geom_line(aes(x = datacom$Datum[154:168] , y = datacom$Piraten[154:168], col = "tan1"),size=0.8) +
geom_line(aes(x = datacom$Datum[169:272] , y = datacom$AfD[169:272], col = "blue"),size=0.8) +
geom_line(aes(x = datacom$Datum , y = datacom$Sonstige, col = "grey"),size=0.8) +
geom_vline(aes(xintercept = datacom$Datum[263], color = "navy"), linetype="longdash",size = 0.5)+
geom_vline(xintercept = datacom$Datum[215], color = "navy", size = 0.5,linetype="longdash")+
geom_vline(xintercept = datacom$Datum[167], color = "navy", size = 0.5,linetype="longdash")+
geom_vline(xintercept = datacom$Datum[127], color = "navy", size = 0.5,linetype="longdash")+
geom_vline(xintercept = datacom$Datum[79], color = "navy", size = 0.5,linetype="longdash")+
geom_vline(xintercept = datacom$Datum[44], color = "navy", size = 0.5,linetype="longdash")+
scale_color_identity(name = NULL, labels = c(black = "CDU/CSU", red = "SPD",green="Die Grünen",gold1="FDP",darkred = "Die Linke/PDS",tan1="Piraten",blue="AfD",grey="Sonstige",navy="Bundestagswahlen"), guide = "legend") +
theme_bw() +
theme(legend.position = "bottom") +
theme(axis.text.x = element_text(angle = 90)) +
labs(title="Forsa-Sonntagsfrage Bundestagswahl in %")+ylab("Prozent")+xlab("Jahre")
plot1
Thanks in advance
Your code has a lot of unnecessary repetition and you are not taking advantage of the syntax of ggplot.
The reason for the vertical dashed lines in the legend is that one of your geom_vline calls includes a color mapping, so its draw key is being added to the legend. You can change its key_glyph to draw_key_path to fix this. Note that you only need a single geom_vline call, since you can have multiple x intercepts.
ggplot(datacom, aes(x = Datum)) +
geom_line(aes(y = `CDU/CSU`, colour = "black"), size = 0.8) +
geom_line(aes(y = SPD, colour = "red"), size = 0.8) +
geom_line(aes(y = GRÜNE, col = "green"), size = 0.8) +
geom_line(aes(y = FDP, col = "gold1"), size = 0.8) +
geom_line(aes(y = `Linke/PDS`, col = "darkred"),size = 0.8) +
geom_line(aes(y = Piraten, col = "tan1"),
data = datacom[154:168,], size = 0.8) +
geom_line(aes(y = AfD, col = "blue"),
data = datacom[169:272,], size = 0.8) +
geom_line(aes(y = Sonstige, col = "grey"), size = 0.8) +
geom_vline(data = datacom[c(263, 215, 167, 127, 79, 44),],
aes(xintercept = Datum, color = "navy"), linetype = "longdash",
size = 0.5, key_glyph = draw_key_path)+
scale_color_identity(name = NULL,
labels = c(black = "CDU/CSU", red = "SPD",
green = "Die Grünen", gold1 = "FDP",
darkred = "Die Linke/PDS",
tan1 = "Piraten", blue = "AfD",
grey = "Sonstige",
navy = "Bundestagswahlen"),
guide = "legend") +
theme_bw() +
theme(legend.position = "bottom",
axis.text.x = element_text(angle = 90)) +
labs(title = "Forsa-Sonntagsfrage Bundestagswahl in %",
y = "Prozent",
x = "Jahre")
An even better way to make your plot would be to pivot the data into long format. This would mean only a single geom_line call:
library(tidyverse)
datacom %>%
mutate(Piraten = c(rep(NA, 153), Piraten[154:168],
rep(NA, nrow(datacom) - 168)),
AfD = c(rep(NA, 168), AfD[169:272],
rep(NA, nrow(datacom) - 272))) %>%
pivot_longer(-Datum, names_to = "Series") %>%
ggplot(aes(x = Datum, y = value, color = Series)) +
geom_line(size = 0.8, na.rm = TRUE) +
geom_vline(data = datacom[c(263, 215, 167, 127, 79, 44),],
aes(xintercept = Datum, color = "Bundestagswahlen"),
linetype = "longdash", size = 0.5, key_glyph = draw_key_path) +
scale_color_manual(name = NULL,
values = c("CDU/CSU" = "black", SPD = "red",
"GRÜNE" = "green", FDP = "gold1",
"Linke/PDS" = "darkred",
Piraten = "tan1", AfD = "blue",
Sonstige = "grey",
"Bundestagswahlen" = "navy")) +
theme_bw() +
theme(legend.position = "bottom",
axis.text.x = element_text(angle = 90)) +
labs(title = "Forsa-Sonntagsfrage Bundestagswahl in %",
y = "Prozent",
x = "Jahre")
Data used to create plot
Obviously, I had to create some data to get your code to run, since you didn't supply any. Here is my code for creating the data
var <- seq(5, 15, length = 280)
datacom <- data.frame(Datum = seq(as.POSIXct("1999-01-01"),
as.POSIXct("2022-04-01"), by = "month"),
`CDU/CSU` = 40 + cumsum(rnorm(280)),
SPD = 40 + cumsum(rnorm(280)),
GRÜNE = rpois(280, var),
FDP = rpois(280, var),
`Linke/PDS` = rpois(280, var),
Piraten = rpois(280, var),
AfD = rpois(280, var),
Sonstige = rpois(280, var), check.names = FALSE)

ggplot with both `geom_vline` and `geom_hline`. Task: need separate legends

library(tidyverse)
library(lubridate)
y <- rnorm(100)
df <- tibble(y) %>%
mutate(os = factor(rep_len(1:5, 100)),
date = seq(from = ymd('2013-01-01'), by = 1, length.out = 100))
ggplot(df, aes(x = date, y = y, colour = os)) +
geom_line() +
geom_vline(
aes(xintercept = min(date), linetype = 'os 1'),
colour = 'red') +
geom_vline(
aes(xintercept = median(date), linetype = 'os 2'),
colour = 'blue') +
geom_hline(
aes(yintercept = 1, linetype = "dashed"),
colour = "black"
) +
scale_linetype_manual(
name = 'lines',
values = c('os 1' = 1, 'os 2' = 1),
guide = guide_legend(override.aes = list(colour = c('red', 'blue'))))
output:
What is wrong with output:
The geom_hline is missing.
The legend combines the vline and the hline to form a cross.
Correct output:
THe geom_hline should be drawn.
Need a separate legend for the vlines and hlines. i.e., lines in the vline legend should be vertical while lines in the hline legend should be horizontal.
This could be achieved by
Adding the hline to scale_linetype_manual
Making use of a custom key glyph as in this answer.
library(tidyverse)
library(lubridate)
set.seed(123)
y <- rnorm(100)
df <- tibble(y) %>%
mutate(os = factor(rep_len(1:5, 100)),
date = seq(from = ymd('2013-01-01'), by = 1, length.out = 100))
draw_key_cust <- function(data, params, size) {
if (data$colour %in% c("red", "blue"))
draw_key_vpath(data, params, size)
else
draw_key_path(data, params, size)
}
ggplot(df, aes(x = date, y = y, colour = os)) +
geom_line() +
geom_vline(
aes(xintercept = min(date), linetype = 'os 1'),
colour = 'red', key_glyph = "cust") +
geom_vline(
aes(xintercept = median(date), linetype = 'os 2'),
colour = 'blue', key_glyph = "cust") +
geom_hline(
aes(yintercept = 1, linetype = "dashed"),
colour = "black", key_glyph = "cust"
) +
scale_linetype_manual(
name = 'lines',
values = c('os 1' = 1, 'os 2' = 1, dashed = 2),
guide = guide_legend(override.aes = list(colour = c('red', 'blue', 'black'))))

How to combine different layers in r ggplot with 2 different datasets - one for map & other for geom_area?

I have created a plot with geom_area(), geom_line() in it. Now I would like to add a country map background in the plot and for same I am trying to use: map_data() & geom_ploygon() but it's giving error, probably because one's xaxis is on date scale & other's is longitude.
Error:
Error: Invalid input: date_trans works with objects of class Date only
Here is my code & plot without map:
library(tidyverse)
library(glue)
library(scales)
library(tidytext)
data:
file_url <- "https://raw.githubusercontent.com/johnsnow09/covid19-df_stack-code/main/ts_all_long3.csv"
ts_all_long <- read.csv(url(file_url))
Step 1:
confirm_col = "#32a4ba"
death_col = "#f08080"
Country_selected = c("India")
scaleFactor = max(ts_all_long %>%
filter(Country.Region %in% Country_selected) %>%
pull(Confirmed_daily)) /
max(ts_all_long %>%
filter(Country.Region %in% Country_selected) %>%
pull(Death_daily))
ts_all_long %>%
filter(Country.Region %in% c("India") ) %>%
ggplot(aes(x = date)) +
geom_area(aes(y = Confirmed_daily), fill = confirm_col, alpha = .7) +
geom_line(aes(y = Death_daily * scaleFactor), col = death_col,
size = 0.8, alpha = 0.8) +
scale_y_continuous(name = "Daily Cases", sec.axis = sec_axis(~./scaleFactor, name = "Daily Deaths"),
labels = scales::comma_format()) +
scale_x_date(date_breaks = "1 month", date_labels = "%b") +
geom_hline(yintercept = c(25000,95000), lty = 2, col = "grey50") +
geom_vline(xintercept = c(ymd("2020-07-08"),ymd("2020-09-10"),
ymd("2021-03-15"),ymd("2021-04-03")),
lty = 2, col = "grey50") +
annotate("text", x = ymd("2020-08-10"), y = 96000, col = death_col, size = 3,
label = "25k to 95k in \n~2months+") +
annotate("text", x = ymd("2021-03-18"), y = 96000, col = death_col, size = 3,
label = "25k to 95k in \n~2weeks+") +
geom_text(
label=glue("1st wave"), angle = 90, x=ymd("2020-07-30"), y= 75000,
size = 4, color = confirm_col
) +
geom_text(
label=glue("2nd wave"), angle = 90, x=ymd("2021-03-18"), y= 75000,
size = 4, color = confirm_col
) +
theme_excel_new() +
theme(
axis.title.y.left=element_text(color=confirm_col),
axis.text.y.left=element_text(color=confirm_col),
axis.title.y.right=element_text(color=death_col),
axis.text.y.right=element_text(color=death_col),
plot.title = element_markdown(face = "plain", family = "serif", size = 14),
panel.grid.major = element_blank()
) +
labs(title = glue("<i>{Country_selected}</i>: Daily Cases to jump to 1 lac in 1st & 2nd wave, as of: {max(ts_all_long$date)}"),
# subtitle = "Cases to jump from 25,000 to 95,000 in first & second wave",
caption = "Data source: covid19.analytics
Created by: ViSa")
Step 2: Code & image for map:
ggplot() +
geom_polygon(data = map_data("world", region = "India"),
aes(x = long, y = lat, group = group),
fill="lightgray", colour = "white")
Step 3: When I try to combine code for above 2 steps I get an error:
confirm_col = "#32a4ba"
death_col = "#f08080"
Country_selected = c("India")
scaleFactor = max(ts_all_long %>%
filter(Country.Region %in% Country_selected) %>%
pull(Confirmed_daily)) /
max(ts_all_long %>%
filter(Country.Region %in% Country_selected) %>%
pull(Death_daily))
ts_all_long %>%
filter(Country.Region %in% c("India") ) %>%
ggplot() +
# added country map here from step2
geom_polygon(data = map_data("world", region = "India"),
aes(x = long, y = lat, group = group),
fill="lightgray", colour = "white") +
# usual plot of step1
geom_area(aes(x = date, y = Confirmed_daily), fill = confirm_col, alpha = .7) +
geom_line(aes(x = date, y = Death_daily * scaleFactor), col = death_col,
size = 0.8, alpha = 0.8) +
scale_y_continuous(name = "Daily Cases", sec.axis = sec_axis(~./scaleFactor, name = "Daily Deaths"),
labels = scales::comma_format()) +
scale_x_date(date_breaks = "1 month", date_labels = "%b") +
geom_hline(yintercept = c(25000,95000), lty = 2, col = "grey50") +
geom_vline(xintercept = c(ymd("2020-07-08"),ymd("2020-09-10"),
ymd("2021-03-15"),ymd("2021-04-03")),
lty = 2, col = "grey50") +
annotate("text", x = ymd("2020-08-10"), y = 96000, col = death_col, size = 3,
label = "25k to 95k in \n~2months+") +
annotate("text", x = ymd("2021-03-18"), y = 96000, col = death_col, size = 3,
label = "25k to 95k in \n~2weeks+") +
geom_text(
label=glue("1st wave"), angle = 90, x=ymd("2020-07-30"), y= 75000,
size = 4, color = confirm_col
) +
geom_text(
label=glue("2nd wave"), angle = 90, x=ymd("2021-03-18"), y= 75000,
size = 4, color = confirm_col
) +
theme_excel_new() +
theme(
axis.title.y.left=element_text(color=confirm_col),
axis.text.y.left=element_text(color=confirm_col),
axis.title.y.right=element_text(color=death_col),
axis.text.y.right=element_text(color=death_col),
plot.title = element_markdown(face = "plain", family = "serif", size = 14),
panel.grid.major = element_blank()
) +
labs(title = glue("<i>{Country_selected}</i>: Daily Cases to jump to 1 lac in 1st & 2nd wave, as of: {max(ts_all_long$date)}"),
# subtitle = "Cases to jump from 25,000 to 95,000 in first & second wave",
caption = "Data source: covid19.analytics
Created by: ViSa")
I would suggest to add the map as a background image to your plot which could be done via e.g. the ggimage package like so:
library(ggimage)
map <- ggplot() +
geom_polygon(data = map_data("world", region = "India"),
aes(x = long, y = lat, group = group),
fill="lightgray", colour = "white") +
theme_void()
ggsave("map.png")
#> Saving 7 x 5 in image
ggbackground(p, "map.png")
p:
d <- ts_all_long %>%
filter(Country.Region %in% c("India")) %>%
mutate(date = as.Date(date))
p <- ggplot(d, aes(x = date)) +
geom_area(aes(y = Confirmed_daily), fill = confirm_col, alpha = .7) +
geom_line(aes(y = Death_daily * scaleFactor), col = death_col,
size = 0.8, alpha = 0.8) +
scale_y_continuous(name = "Daily Cases", sec.axis = sec_axis(~./scaleFactor, name = "Daily Deaths"),
labels = scales::comma_format()) +
scale_x_date(date_breaks = "1 month", date_labels = "%b") +
geom_hline(yintercept = c(25000,95000), lty = 2, col = "grey50") +
geom_vline(xintercept = c(ymd("2020-07-08"),ymd("2020-09-10"),
ymd("2021-03-15"),ymd("2021-04-03")),
lty = 2, col = "grey50") +
annotate("text", x = ymd("2020-08-10"), y = 96000, col = death_col, size = 3,
label = "25k to 95k in \n~2months+") +
annotate("text", x = ymd("2021-03-18"), y = 96000, col = death_col, size = 3,
label = "25k to 95k in \n~2weeks+") +
geom_text(
label=glue("1st wave"), angle = 90, x=ymd("2020-07-30"), y= 75000,
size = 4, color = confirm_col
) +
geom_text(
label=glue("2nd wave"), angle = 90, x=ymd("2021-03-18"), y= 75000,
size = 4, color = confirm_col
) +
theme_excel_new() +
theme(
axis.title.y.left=element_text(color=confirm_col),
axis.text.y.left=element_text(color=confirm_col),
axis.title.y.right=element_text(color=death_col),
axis.text.y.right=element_text(color=death_col),
plot.title = element_markdown(face = "plain", family = "serif", size = 14),
panel.grid.major = element_blank()
) +
labs(title = glue("<i>{Country_selected}</i>: Daily Cases to jump to 1 lac in 1st & 2nd wave, as of: {max(ts_all_long$date)}"),
# subtitle = "Cases to jump from 25,000 to 95,000 in first & second wave",
caption = "Data source: covid19.analytics
Created by: ViSa")

how to ggplot with upper and lower bound as shaded using facet_wrap in R?

I am trying to automate the process of plotting data using ggplot and the facet_wrap functionality. I want a single y-axis label instead individual plot Ob (i.e., A_Ob, B_ob etc) and also a single X-axis not all the plots having label for x-axis such as below. Below is my sample code using gridextra package. However, i would like to do it through facet_wrap as i have many other plots to draw which i think will save me sometime.
graphics.off()
rm(list = ls())
library(tidyverse)
library(gridExtra)
G1 = data.frame(A_Ob = runif(1000, 5, 50), A_Sim = runif(1000, 3,60), A_upper = runif(1000, 10,70), A_lower = runif(1000, 0, 45 ),
B_Ob = runif(1000, 5, 50), B_Sim = runif(1000, 3,60), B_upper = runif(1000, 10,70), B_lower = runif(1000, 0, 45 ),
C_Ob = runif(1000, 5, 50), C_Sim = runif(1000, 3,60), C_upper = runif(1000, 10,70), C_lower = runif(1000, 0, 45 ),
D_Ob = runif(1000, 5, 50), D_Sim = runif(1000, 3,60), D_upper = runif(1000, 10,70), D_lower = runif(1000, 0, 45 ),
Pos = 1:1000)
A1 = ggplot(data = G1, aes(x = Pos))+
geom_line(aes(y = A_Ob), col = "black")+
geom_line(aes(y = A_Sim), col = "blue")+
geom_vline(xintercept = 750, color = "red", size=1.5)+
geom_ribbon(aes(ymin = A_upper, ymax = A_lower), fill = "grey70")
B1 = ggplot(data = G1, aes(x = Pos))+
geom_line(aes(y = B_Ob), col = "black")+
geom_line(aes(y = B_Sim), col = "blue")+
geom_vline(xintercept = 750, color = "red", size=1.5)+
geom_ribbon(aes(ymin = B_upper, ymax = B_lower), fill = "grey70")
C1 = ggplot(data = G1, aes(x = Pos))+
geom_line(aes(y = C_Ob), col = "black")+
geom_line(aes(y = C_Sim), col = "blue")+
geom_vline(xintercept = 750, color = "red", size=1.5)+
geom_ribbon(aes(ymin = C_upper, ymax = C_lower), fill = "grey70")
D1 = ggplot(data = G1, aes(x = Pos))+
geom_line(aes(y = D_Ob), col = "black")+
geom_line(aes(y = D_Sim), col = "blue")+
geom_vline(xintercept = 750, color = "red", size=1.5)+
geom_ribbon(aes(ymin = D_upper, ymax = D_lower), fill = "grey70")
grid.arrange(A1,B1,C1,D1, nrow = 4)
Here is the result of the code
You need to reshape your dataframe into a longer format and separate values for Ob, Sim, upper and lower.
Using the function melt from data.table package can help you to achieve this:
library(data.table)
setDT(G1)
Ob_cols = grep("_Ob",colnames(G1),value = TRUE)
Sim_cols = grep("_Sim",colnames(G1),value = TRUE)
Upper_cols = grep("_upper",colnames(G1), value = TRUE)
Lower_cols = grep("_lower", colnames(G1), value = TRUE)
g.m <- melt(G1, measure = list(Ob_cols,Sim_cols,Upper_cols,Lower_cols), value.name = c("OBS","SIM","UP","LOW"))
levels(g.m$variable) <- c("A","B","C","D")
Pos variable OBS SIM UP LOW
1: 1 A 5.965488 29.167666 26.66783 29.97259
2: 2 A 23.855719 8.570245 43.75830 30.65616
3: 3 A 16.947887 51.201047 15.20758 39.76122
4: 4 A 49.883306 3.715319 34.38066 20.73177
5: 5 A 5.021938 3.102880 30.05036 32.05123
6: 6 A 19.887176 15.400853 53.67156 28.54982
and now, you can plot it:
library(ggplot2)
ggplot(g.m, aes(x = Pos))+
geom_line(aes(y = OBS), color = "black")+
geom_line(aes(y = SIM), color = "blue")+
geom_vline(xintercept = 750,color = "red", size = 1.5)+
geom_ribbon(aes(ymin = UP, ymax = LOW), fill = "grey70")+
facet_grid(variable~.)
EDIT: Adding annotations & renaming labels
To rename and replace facet labels, you can re-define levels of variable and use facet_wrap instead of facet_grid using ncol = 1 as argument.
To add multiple annotations on a single panel, you need to define a dataframe that you will use in geom_text.
Altogether, you have to do:
# renaming names of each facets:
levels(g.m$variable) <- c("M1","M2","M3","M4")
# Defining annotations to add:
df_text <- data.frame(label = c("Calibration", "Validation"),
x = c(740,760),
y = c(65,65),
hjust = c(1,0),
variable = factor("M1", levels = c("M1","M2","M3","M4")))
# Plotting
ggplot(g.m, aes(x = Pos))+
geom_line(aes(y = OBS), color = "black")+
geom_line(aes(y = SIM), color = "blue")+
geom_vline(xintercept = 750,color = "red", size = 1.5)+
geom_ribbon(aes(ymin = UP, ymax = LOW), fill = "grey70")+
facet_wrap(variable~., ncol = 1)+
theme(strip.text.x = element_text(hjust = 0),
strip.background = element_rect(fill = "white"))+
geom_text(data = df_text, aes(x = x, y = y, label = label, hjust = hjust), color = "red")
Does it look what you are expecting ?

Resources