Search code examples
rshinyplotly

Retain some plotly traces when subsetting input data with sliderInput in shiny (R)

I'm trying to make an interactive plot that highlights clicks on a plotly plot in shiny and lets the user change the range of data displayed on the plot with sliderInput. I'm trying to retain already added traces if the range is changed after the user has already added clicks. Currently, it removes all existing traces because it completely renders the plot new each time.

I'm using addTraces instead of restyle the clicked marker because I also want to be able to delete traces and this was easier than restyling individual markers. I'm subsetting the data used to render the plot instead of just changing the x axis limits because I work with very long timeseries with tens of thousands of datapoints, and subsetting appears to greatly improve performance, which otherwise was very slow.

I tried adapting the accepted answer to this question, but because the use case is a little different and the data structure more complex, wasn't really able to. I'm still new to shiny, which probably is part of the problem.

I tried saving the corresponding values of each added trace into a reactive dataframe and add the traces upon observeEvent, but that didn't seem to work either.

#Sample Data
df<-data.frame(t=seq(as.POSIXct("2024-01-01 00:00:00", tz='UTC'),
                     as.POSIXct("2024-01-02 00:00:00", tz='UTC'), by="1 hour"),
               V1=sample(1:20,25, replace=T))

library(shiny)
library(plotly)

# UI

ui <-fluidPage(
  fluidRow(style = "padding: 15px;",
             actionButton("remove", "Delete last click", width='150px') 
  ),
  fluidRow(style = "padding: 0px;",
           plotlyOutput("plot"),
           div(style = "margin: auto; width: 90%",
               sliderInput("range", label = NULL, width="100%",
                           min = as.POSIXct(min(df$t), tz='UTC'), 
                           max = as.POSIXct(max(df$t), tz='UTC'), 
                           value = c(as.POSIXct(min(df$t), tz='UTC'), 
                                     as.POSIXct(max(df$t), tz='UTC')),
                           timeFormat="%F %T", timezone="+0000")
           ))
)

# SERVER

server <- function(input, output, session) {
  
  output$plot <- renderPlotly({
    df[df$t>=input$range[1] & df$t <=input$range[2],] %>%
      plot_ly(x= ~t, y = ~V1, type='scatter', mode='line')%>%
      layout(showlegend=F) 
  })
  
  # highlight clicked point
  observeEvent(event_data("plotly_click"),{
    d <- req(event_data("plotly_click"))
    
    plotlyProxy("plot", session) %>%
      plotlyProxyInvoke("addTraces",list(x =c(d$x,d$x), y=c(d$y,d$y), type = 'scatter',
                                         marker=list(symbol='x', size=10, color='red')))
    })
  
  # remove last click
  observeEvent(input$remove, {
    plotlyProxy("plot", session) %>%
      plotlyProxyInvoke("deleteTraces", list(-1))
  })
}

shinyApp(ui,server)

Interactive Plotly

Attempt with observeEvent(input$range,{}): (doesn't work, i.e. does not add traces)

server <- function(input, output, session) {
  
  vals<-reactiveValues(
    d_click = data.frame()
  )
  
  output$plot <- renderPlotly({
    df[df$t>=input$range[1] & df$t <=input$range[2],] %>%
      plot_ly(x= ~t, y = ~V1, type='scatter', mode='line')%>%
      layout(showlegend=F)
  })
  
  #did my slider range change and I already have highlighted points?
  observeEvent(input$range,{
    if(dim(vals$d_click)[1]>0){
      plotlyProxy("plot", session) %>%
        plotlyProxyInvoke("addTraces",list(list(x=c(vals$d_click$x,vals$d_click$x), 
                                                y=c(vals$d_click$y,vals$d_click$y), 
                                                type = 'scatter',
                                                marker=list(symbol='x', size=10, color='red'))))
    }
  })
  
  # highlight clicked point
  observeEvent(event_data("plotly_click"),{
    d <- req(event_data("plotly_click"))
    
    plotlyProxy("plot", session) %>%
      plotlyProxyInvoke("addTraces",list(x =c(d$x,d$x), y=c(d$y,d$y), type = 'scatter',
                                         marker=list(symbol='x', size=10, color='red')))
    
      vals$d_click<-rbind(vals$d_click,d)
  })
  
  # remove last click
  observeEvent(input$remove, {
    plotlyProxy("plot", session) %>%
      plotlyProxyInvoke("deleteTraces", list(-1))
    
    vals$d_click <- vals$d_click[-nrow(vals$d_click),]
  })
}
Solution

  • You can update the data like this:

      output$plot <- renderPlotly({
    df %>%
      plot_ly(x= ~t, y = ~V1, type='scatter', mode='line')%>%
      layout(showlegend=F) 
  })

  Dat <- eventReactive(input$range, {
    df[df$t >= input$range[1] & df$t <= input$range[2], ]
  })
  
  observeEvent(Dat(), {
    plotlyProxy("plot", session) %>%
      plotlyProxyInvoke("restyle", list(x = list(Dat()$t), y = list(Dat()$V1)), 0)
  })

    The 0 in plotlyProxyInvoke means that the restyling must be applied to trace 0 only.

    However, if you added some points by clicking and if these points are outside the selected time range, then the time range of the plot will include these points. So you have to update the xaxis range too:

      observeEvent(Dat(), {
    plotlyProxy("plot", session) %>%
      plotlyProxyInvoke("restyle", list(x = list(Dat()$t), y = list(Dat()$V1)), 0)
    plotlyProxy("plot", session) %>%
      plotlyProxyInvoke("relayout", list(xaxis = list(range = input$range)))
  })