rplotlyannotate

Highlight areas of interactive time series plotly plot where y is greater than defined threshold and annotate them

I would like to highlight sections of plotly plot that have values higher than a certain threshold and annotate them. As I am manually screening each highlighted area on the plots is there a way I can add the text Pos or Neg individually to each highlighted area on the plotly plot?

# 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

When I create the plotly plot the highlighted areas do not appear. Can I add them to plotly plot?

Solution

  • I only just came across your question last night, I hope this still helps.

    There are a few things going on here from the conversion between ggplot and plotly

    You can create the shapes using the same data that you used in geom_rect using 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))
})

    You can address the numbers-that-are-not-dates-anymore issue with a fixer() function, going through the data in plot and updating the variable type.

    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
}

    When you apply these elements to the plot, you need to make sure the other presets assigned in the conversion are not going to get in your way:

    Here's how to put that all together.

    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

    blue plot

    Alternatively...as you have identified 2 plots...

    This may be something that's better applied dynamically. (Dynamic-ish...still relies on a lot of assumptions..)

    This combines all of the concepts above into one plot. Instead of using the methods you used in your call to geom_rect, it pulls the data in the ggplot object.

    library(tidyverse)
library(plotly)

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
}

tSpan <- function(gplt) {  # gplt: ggplot graph to be made into a ggplotly 
  #  - assuming one x-axis within gplt
  #  - assuming geom_rect called 2nd in gplt
  
  # 2 here, because geom_rect was called 2nd            --- get data from plot
  dta <- data.frame(ggplot_build(gplt)$data[[2]][c("xmin", "xmax", "fill", "alpha")]) %>% 
    mutate(xmin = as.POSIXct(xmin), xmax = as.POSIXct(xmax))

  shps <- map(1:nrow(dta), \(k) {    # create data used in geom_rect
    list(type = "rect", xref = "x", yref = "paper",  # define shape, use x axis, not y axis
         x0 = dta$xmin[k], x1 = dta$xmax[k],         # where on x
         y0 = 0, y1 = 1,                             # where on plot (versus y)
                                                     # update aesthetics
         fillcolor = dta$fill[1], opacity = dta$alpha[1], line = list(width = 0))
    })
  
  ggplotly(gplt) %>%              # pre 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
}

tSpan(plot_var2)
tSpan(plot_var1)

    red plot