Home > database >  Draw a dashed transparent box around forecast lines
Draw a dashed transparent box around forecast lines

Time:07-02

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:

enter image description here

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")

CodePudding user response:

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

enter image description here

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")

enter image description here

CodePudding user response:

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")

enter image description here

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.

  • Related