突出显示交互式时间序列的区域，其中 y 大于定义的阈值并对其进行注释

Question

我想突出显示绘图中值高于特定阈值的部分并对其进行注释。当我手动筛选绘图上的每个突出显示区域时，是否有一种方法可以将文本 Pos 或 Neg 单独添加到绘图上的每个突出显示区域？

# Load packages
library(xts)
#> Loading required package: zoo
#> 
#> Attaching package: 'zoo'
#> The following objects are masked from 'package:base':
#> 
#>     as.Date, as.Date.numeric
library(ggplot2)
library(gridExtra)
library(plotly)
#> 
#> Attaching package: 'plotly'
#> The following object is masked from 'package:ggplot2':
#> 
#>     last_plot
#> The following object is masked from 'package:stats':
#> 
#>     filter
#> The following object is masked from 'package:graphics':
#> 
#>     layout

# Create time series data every 15 minutes for 2 different variables
start_time <- as.POSIXct("2024-05-01 00:00:00")
end_time <- as.POSIXct("2024-05-02 00:00:00")
time_seq <- seq(from = start_time, to = end_time, by = "15 min")

# Variable 1
variable1 <- rnorm(length(time_seq), mean = 25, sd = 5)
variable1
#>  [1] 19.64150 21.91925 30.26140 24.73885 15.62106 24.42389 23.66606 29.51821
#>  [9] 28.73607 29.74207 27.91748 30.50421 22.87791 21.98245 24.62681 26.63759
#> [17] 35.72062 25.35210 24.80731 11.10508 23.51079 16.52044 27.82598 22.25517
#> [25] 22.91079 29.21557 25.83038 28.42228 21.08665 19.49110 19.08057 27.76373
#> [33] 27.79809 34.81478 19.66126 29.43602 27.07366 30.06237 17.23155 22.55079
#> [41] 23.93064 22.00335 28.37549 19.24512 17.07143 24.20822 17.40344 16.85957
#> [49] 22.63171 14.34134 23.23399 25.18874 16.35321 22.83617 21.86500 26.76390
#> [57] 21.45600 35.34945 19.06585 18.04736 15.99879 32.98314 28.72129 23.41016
#> [65] 25.32476 24.55138 29.47520 16.39592 23.14157 21.38850 19.58153 23.72860
#> [73] 26.21399 27.22447 23.78197 23.12036 29.35689 25.86351 25.20781 22.89124
#> [81] 32.17681 36.02693 23.75858 20.67829 28.79505 19.32367 23.73758 25.86511
#> [89] 18.71596 28.19968 16.28308 24.59351 30.57592 25.06673 29.30346 35.90666
#> [97] 29.07116
str(variable1)
#>  num [1:97] 19.6 21.9 30.3 24.7 15.6 ...

# Variable 2
variable2 <- rnorm(length(time_seq), mean = 350, sd = 20)

# Create dataframe of the 2 variables
df <- data.frame(DateTime = time_seq, Variable1 = variable1, Variable2 = variable2)
head(df)
#>              DateTime Variable1 Variable2
#> 1 2024-05-01 00:00:00  19.64150  331.8194
#> 2 2024-05-01 00:15:00  21.91925  360.4271
#> 3 2024-05-01 00:30:00  30.26140  343.6143
#> 4 2024-05-01 00:45:00  24.73885  362.8967
#> 5 2024-05-01 01:00:00  15.62106  355.4895
#> 6 2024-05-01 01:15:00  24.42389  347.0129
str(df)
#> 'data.frame':    97 obs. of  3 variables:
#>  $ DateTime : POSIXct, format: "2024-05-01 00:00:00" "2024-05-01 00:15:00" ...
#>  $ Variable1: num  19.6 21.9 30.3 24.7 15.6 ...
#>  $ Variable2: num  332 360 344 363 355 ...



# Highlight areas on the plot where Variable 1 > 28.3
plot_var1 <- ggplot(df, aes(x = DateTime, y = Variable1))+
  geom_line(color = "blue") +
  geom_rect(data = subset(df, Variable1 > 28.3),
  aes(xmin = DateTime-450, xmax = DateTime+450, ymin = -Inf, ymax = Inf),
  fill = "lightblue", alpha = 0.3) +
  labs(x = "Time", y = "Variable 1")
plot_var1


# Highlight areas on the plot where Variable 2 is between 335 and 390
plot_var2 <- ggplot(df, aes(x = DateTime, y = Variable2)) +
  geom_line(color = "red") +
  geom_rect(data = subset(df, Variable2 > 335 & Variable2 < 390),
            aes(xmin = DateTime-450, xmax = DateTime+450, ymin = -Inf, ymax = Inf),
            fill = "lightpink", alpha = 0.3) +
  labs(x = "Time", y = "Variable 2") +
  theme_minimal()
plot_var2


# Arrange plots in one column and align by x-axis
Comb_Var1_Var2_Highlight_Plot<-grid.arrange(plot_var1, plot_var2, ncol = 1)



# Interactive Plot for Variable 1
Int_plot_Var1<-ggplotly(plot_var1)

# Interactive plot for Variable 2
Int_plot_Var2<-ggplotly(plot_var2)
Created on 2024-07-17 with reprex v2.1.0

当我创建绘图时，突出显示的区域不会出现。 我可以将它们添加到情节中吗？

Answer 1

我昨晚才发现你的问题，希望这仍然有帮助。

ggplot 和plotly 之间的转换发生了一些事情

• 日期不再是日期 - 通常只是数字
• x 轴是静态的，因为它为特定值分配了类别名称
• 绘图填充和绘图线条并不能很好地结合在一起（使用形状效果更好）

您可以使用

geom_rect

中使用的相同数据创建形状。purrr::map

您可以使用 

library(tidyverse) # replaced ggplot2 for purr & ggplot2
library(plotly)

shps <- map(1:nrow(subset(df, Variable1 > 28.3)), \(k) {
  dta <- subset(df, Variable1 > 28.3)    # create data used in geom_rect
  list(type = "rect",                    # define shape for Plotly
       xref = "x", yref = "paper",       # use x axis, not y axis
       x0 = dta$DateTime[k] - 450,       # where on x
       x1 = dta$DateTime[k] + 450,
       y0 = 0, y1 = 1,                   # where on plot (versus y)
       fillcolor = "lightblue", opacity = .3, line = list(width = 0))
})

函数解决 不再是日期的数字 问题，遍历图中的数据并更新变量类型。

fixer()

将这些元素应用于绘图时，您需要确保转换中分配的其他预设不会妨碍您：

x 轴的刻度模式、类型以及是否

fixer <- function(plt) {  
  plt <- plotly_build(plt)              # make sure entire plot built
  lapply(1:length(plt$x$data), \(k) {   # go through each trace (layer) 
    plt$x$data[[k]]$x <<- as.POSIXct(plt$x$data[[k]]$x) # update x-axis data type
  })
  plt
}

• 删除不是形状的形状——为什么或者为什么Plotly？ （或者是ggplot？）
以下是如何将它们组合在一起。

autorange

或者...因为您已经确定了 2 个地块...

这可能是最好动态应用的东西。 （动态的......仍然依赖于很多假设......）

这将上述所有概念合并到一个图中。它不使用您在调用

ggplotly(plot_var1) %>%             # prep xaxis for dates
  layout(xaxis = list(tickmode = "auto", type = "date", autorange = T),
         shapes = NA) %>%           # remove migration garbage
  fixer() %>%                       # fix dates - make them dates again
  layout(shapes = shps)             # add new shapes

时使用的方法，而是提取

geom_rect

对象中的数据。ggplot