在预测线上画一个虚线的透明盒

Question

我有3个预测图，这些图由plotly :: subprot组合在一起。下一步是绘制一个透明的框（或3个单独的框），并在每个图的预测线周围有红色虚线，以便它们脱颖而出。

我该怎么做？

所需输出：

数据（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))

代码

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

实际上，我更喜欢一个盒子上的一个盒子。这样做很难，因为使用ggplotly和layout（）函数似乎存在一个已知问题。这就是为什么将形状放入p $ x $布局$形状中的原因。

# 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

虚线盒的替代方案可以使用不透明度。

list(type = "rect",
     fillcolor = "red", 
     opacity = 0.1,
     x0 = 2021, 
     x1 = 2030, 
     xref = "x", 
     y0 = 0, 
     y1 = 1, 
     yref = "paper")

Answer 2

我还可以通过在每个图中制作一个红色盒子来为您带来一些方式，但是在整个图中放一个盒子将更具挑战性。

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

add_box（）函数做一些不同的事情。首先，它可以构建您的情节，因此我可以抓住X和Y轴的范围。如果您尝试将框一直绘制到范围的末端，则顶部，底部和右侧线不会打印。因此，我让它将这些边缘prop_in将其拉到图内的内部。我发现.05是有效的最小的。然后，我更改rgx和rgy对象。然后，我用rgx的第一个且可选的第二值用start和stop从函数调用中进行参数。我采用范围值，并将它们变成数据框。