Draw a dashed transparent box around forecast lines - r

Question

I have 3 forecast plots that are combined together by plotly::subplot. The next step is draw a transparent box (or 3 separate boxes) with red dashed lines around the forecast line of each plot so that they stand out to the reader.
How can I do this ?
Desired Output:
Data (df):
structure(list(year = 1980:2021, AvgTMean = c(24.2700686838937,
23.8852956598276, 25.094446596092, 24.1561175050287, 24.157183605977,
24.3047482638362, 24.7899738481466, 24.5756232655603, 24.5833086228592,
24.7344695534483, 25.3094451071121, 25.2100615173707, 24.3651692293534,
24.5423890611494, 25.2492166633908, 24.7005097837931, 24.2491591827443,
25.0912281781322, 25.0779264303305, 24.403294248319, 24.4983991453592,
24.4292324356466, 24.8179824927011, 24.7243948463075, 24.5086534543966,
24.2818632071983, 24.4567195220259, 24.8402224356034, 24.6574465515086,
24.5440715673563, 23.482670620977, 24.9979594684914, 24.5452453980747,
24.9271462811494, 24.7443215819253, 25.8929839790805, 25.1801908261063,
25.2079308058908, 25.0722425561207, 25.4554644289799, 25.4548979078736,
25.0756772250287), AvgTMin = c(19.6018663372126, 18.9935718486724,
20.8351710187356, 19.7723002680316, 19.8097384811782, 19.7280847671034,
20.2907499842098, 20.1950373662931, 20.1812715311494, 20.1808865070833,
21.0320272801006, 21.1252427976293, 20.1712830368678, 20.407655174727,
21.5430646243391, 20.6760574525862, 20.0822658237356, 21.0735574619397,
21.0871494406322, 20.1311178414224, 20.3191250001149, 20.3474683732557,
20.668169553204, 20.3772270269296, 20.2330157893678, 19.9486551337931,
20.1114496908333, 20.5816350393966, 20.4033879191236, 20.1582514856897,
19.2288879223678, 20.8451063140805, 20.4878865041092, 21.0259712576437,
20.5510100674138, 22.0143793370977, 21.3529094881753, 21.1688506012213,
21.040550304569, 21.4923981385632, 21.6580430460057, 21.2433069288506
), AvgTMax = c(28.9392198638937, 28.778245693046, 29.3549223685201,
28.5411393752011, 28.5058118063649, 28.8825532046983, 29.2903534709195,
28.9574051835776, 28.9865201368247, 29.2891997662069, 29.5881379007328,
29.2960976760201, 28.5602557685057, 28.6782844806753, 28.9566034394684,
28.7262054694971, 28.4171896994397, 29.1100747038649, 29.0698836095546,
28.6766350461063, 28.6788764437787, 28.5122026355891, 28.9690143596839,
29.0727844759914, 28.7854971337931, 28.6163189712069, 28.8032270024138,
29.1000460207471, 28.9127356101149, 28.9310646744109, 27.7376810545833,
29.1520129070402, 28.6037845089512, 28.8295359311638, 28.9388276133764,
29.7726939654598, 29.0086407880029, 29.2482097613937, 29.1050890698132,
29.4187571974569, 29.2519238543247, 28.9081913630029)), class = "data.frame", row.names = c(NA,
-42L))
Code
library(tidyverse)
library(plotly)
AvgTMeanYearFP = ggplot(df, aes(year, AvgTMean)) +
geom_smooth(method = 'lm', fullrange = TRUE) +
annotate('rect', xmin = -Inf, xmax = 2021, ymin = -Inf, ymax = Inf,
fill = 'gray92') +
geom_vline(xintercept = seq(1980, 2020, 5), color = 'white') +
geom_hline(yintercept = seq(23.5, 25.5, 0.5), color = 'white') +
geom_line() +
scale_x_continuous(limits = c(1980, 2030)) +
labs(y = "Avg. Mean T (C)", x = "Year") +
geom_text(aes(x = 2000 , y = 25.5, label = "Historic Trend")) +
geom_text(aes(x = 2025 , y = 25.5, label = "Forecast Trend"))
AvgTMinYearFP = ggplot(df, aes(year, AvgTMin)) +
geom_smooth(method = 'lm', fullrange = TRUE) +
annotate('rect', xmin = -Inf, xmax = 2021, ymin = -Inf, ymax = Inf,
fill = 'gray92') +
geom_vline(xintercept = seq(1980, 2020, 5), color = 'white') +
geom_hline(yintercept = seq(23.5, 25.5, 0.5), color = 'white') +
geom_line() +
scale_x_continuous(limits = c(1980, 2030)) +
ylim(18, 23) +
labs(y = "Avg. Min. T (C)", x = "Year")
AvgTMaxYearFP = ggplot(df, aes(year, AvgTMax)) +
geom_smooth(method = 'lm', fullrange = TRUE) +
annotate('rect', xmin = -Inf, xmax = 2021, ymin = -Inf, ymax = Inf,
fill = 'gray92') +
geom_vline(xintercept = seq(1980, 2020, 5), color = 'white') +
geom_hline(yintercept = seq(23.5, 25.5, 0.5), color = 'white') +
geom_line() +
scale_x_continuous(limits = c(1980, 2030)) +
ylim(27, 30) +
labs(y = "Avg. Max. T (C)", x = "Year")
# Combine plots
subplot(AvgTMeanYearFP, AvgTMinYearFP, AvgTMaxYearFP, titleY = TRUE, shareX = TRUE, nrows = 3) %>%
layout(title ="Historic Average Temperature And Future Temperature Projection")

Answer 1

I actually like one box over all plots more aesthetically. Had a hard time doing this, because there seems to be a known issue with using ggplotly and the layout() function. That's why the shapes are put in p$x$layout$shapes like this.
# Combine plots
p <- subplot(AvgTMeanYearFP, AvgTMinYearFP, AvgTMaxYearFP, titleY = TRUE, shareX = TRUE, nrows = 3) %>%
layout(title ="Historic Average Temperature And Future Temperature Projection")
p$x$layout$shapes <- list(type = "rect",
line = list(color = "red",
dash = 'dash'),
x0 = 2021,
x1 = 2030,
xref = "x",
y0 = 0,
y1 = 1,
yref = "paper")
p
An alternative to a dashed box could be using the opacity.
list(type = "rect",
fillcolor = "red",
opacity = 0.1,
x0 = 2021,
x1 = 2030,
xref = "x",
y0 = 0,
y1 = 1,
yref = "paper")

Answer 2

I can also get you some of the way there - by making a red box in each figure, but putting a single box across the whole plot is going to be more challenging.
library(tidyverse)
library(plotly)
add_box <- function(p, start=2022, stop=NULL, prop_in=.05, ...){
pb <- ggplot_build(p)
rgy <- pb$layout$panel_params[[1]]$y.range
rgx <- pb$layout$panel_params[[1]]$x.range
px1 <- diff(rgx)*prop_in
py1 <- diff(rgy)*prop_in
rgx <- c(1,-1)*px1 + rgx
rgy <- c(1,-1)*py1 + rgy
rgx[1] <- start
if(!is.null(stop)){
rgx[2] <- stop
}
boxdf <- data.frame(x = rgx[c(1,2,2,1,1)],
y=rgy[c(1,1,2,2,1)])
p + geom_path(data=boxdf,
aes(x=x,
y=y),
col="red",
linetype=2)
}
AvgTMeanYearFP = ggplot(df, aes(year, AvgTMean)) +
geom_smooth(method = 'lm', fullrange = TRUE) +
annotate('rect', xmin = -Inf, xmax = 2021, ymin = -Inf, ymax = Inf,
fill = 'gray92') +
geom_vline(xintercept = seq(1980, 2020, 5), color = 'white') +
geom_hline(yintercept = seq(23.5, 25.5, 0.5), color = 'white') +
geom_line() +
scale_x_continuous(limits = c(1980, 2030)) +
labs(y = "Avg. Mean T (C)", x = "Year") +
geom_text(aes(x = 2000 , y = 25.5, label = "Historic Trend")) +
geom_text(aes(x = 2025 , y = 25.5, label = "Forecast Trend"))
AvgTMinYearFP = ggplot(df, aes(year, AvgTMin)) +
geom_smooth(method = 'lm', fullrange = TRUE) +
annotate('rect', xmin = -Inf, xmax = 2021, ymin = -Inf, ymax = Inf,
fill = 'gray92') +
geom_vline(xintercept = seq(1980, 2020, 5), color = 'white') +
geom_hline(yintercept = seq(23.5, 25.5, 0.5), color = 'white') +
geom_line() +
scale_x_continuous(limits = c(1980, 2030)) +
ylim(18, 23) +
labs(y = "Avg. Min. T (C)", x = "Year")
AvgTMaxYearFP = ggplot(df, aes(year, AvgTMax)) +
geom_smooth(method = 'lm', fullrange = TRUE) +
annotate('rect', xmin = -Inf, xmax = 2021, ymin = -Inf, ymax = Inf,
fill = 'gray92') +
geom_vline(xintercept = seq(1980, 2020, 5), color = 'white') +
geom_hline(yintercept = seq(23.5, 25.5, 0.5), color = 'white') +
geom_line() +
scale_x_continuous(limits = c(1980, 2030)) +
ylim(27, 30) +
labs(y = "Avg. Max. T (C)", x = "Year")
# Combine plots
subplot(AvgTMeanYearFP %>% add_box(stop=2030, prop_in=.05),
AvgTMinYearFP %>% add_box(stop=2030, prop_in=.05),
AvgTMaxYearFP %>% add_box(stop=2030, prop_in=.05),
titleY = TRUE, shareX = TRUE, nrows = 3) %>%
layout(title ="Historic Average Temperature And Future Temperature Projection")
The add_box() function does a few different things. First, it builds your plot so I can grab the ranges of the x and y axes. If you try to plot the box all the way to the end of the range, the top, bottom and right side lines don't print. So, I have it pull the those edges prop_in toward the interior of the plot. I found that .05 is about the smallest that worked. Then, I change the rgx and rgy objects accordingly. Then, I replace the first and optionally second value of rgx with the start and stop arguments from the function call. I take the range values and make them into a data frame that will be amenable to plot with geom_path() and then I add the appropriate geom_path() function to your existing plot.