我有 3 個預測圖，它們由plotly::subplot. 下一步是在每個圖的預測線周圍繪制一個帶有紅色虛線的透明框（或 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")
uj5u.com熱心網友回復：
實際上，我更喜歡一個盒子來覆寫所有地塊。很難做到這一點，因為使用ggplotly和 layout() 函式似乎存在一個已知問題。這就是為什么形狀是這樣放置的p$x$layout$shapes。
# 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")
uj5u.com熱心網友回復：
我也可以為您提供一些方法-通過在每個圖中制作一個紅色框，但是在整個情節中放置一個框將更具挑戰性。
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中的startand引數替換第一個和可選的第二個值。stop我采用范圍值并將它們制作成一個可以繪制的資料框，geom_path()然后將適當的geom_path()函式添加到您現有的繪圖中。
轉載請註明出處，本文鏈接：https://www.uj5u.com/shujuku/498306.html