Update the underlying data values of some traces in shiny plotly in R

Question

I'm trying to write a shiny app that lets the user highlight clicked points on a plotly plot as well as toggle between two different x axis formats (timestamp and numeric). I can't get the added traces to update, though, and I'm not sure I understand why.

library(shiny)
library(plotly)
library(DT)

df<-data.frame(t1=seq(as.POSIXct("2024-01-01 00:00:00", tz='UTC'),
                      as.POSIXct("2024-01-02 00:00:00", tz='UTC'), by="1 hour"),
               t2=c(0:24),
               V1=sample(1:50,25, replace=T))

ui <-shinyUI(fluidPage(
  fluidRow(
  radioButtons("timeformat", label=NULL,inline = TRUE,
               c("Datetime", "Hour")),
  plotlyOutput("plot"),
  dataTableOutput("table")
  )
))

server <- function(input, output, session) {
  
  vals<-reactiveValues(
    df = df,
    d_click = data.frame(),
    selections=NULL
  )
  
  observe(
    if(input$timeformat=='Datetime'){
      vals$df$t<- vals$df$t1
    }else{
      vals$df$t<- vals$df$t2
    }
  )
  
  output$plot <- renderPlotly({
      vals$df %>%
        plot_ly()%>%
        add_trace(x= ~t, y = ~V1, type='scatter', mode='line', visible=T)%>%
        layout(showlegend=F)
  })
  
  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')
          ))
        
        click<-vals$df[d$pointNumber+1,names(vals$df)!='t']
        vals$d_click<-rbind(vals$d_click,click)
        vals$selections<-vals$d_click
    })
  
  observe(
      if(input$timeformat=='Datetime'){
        vals$selections$t<- vals$d_click$t1
      }else{
        vals$selections$t<- vals$d_click$t2
      }
  )
  
  observeEvent(input$dateformat,{
    if(nrow(vals$d_click)>0){
      for(i in 1:length(vals$selections)){
        plotlyProxy("plot", session) %>%
          plotlyProxyInvoke("restyle", "line", list(x=c(vals$selections$t[i],vals$selections$t[i]),
                                                    y=c(vals$selections$V1[i],vals$selections$V1[i])),i)
      }}
    })
  
  output$table<-renderDataTable({
    vals$selections
  })   
  
}

shinyApp(ui,server)

Answer 1

Is it what you want?

library(shiny)
library(plotly)
library(DT)

df <- data.frame(t1=seq(as.POSIXct("2024-01-01 00:00:00", tz='UTC'),
                        as.POSIXct("2024-01-02 00:00:00", tz='UTC'), by="1 hour"),
                 t2=c(0:24),
                 V1=sample(1:50,25, replace=T))

ui <- fluidPage(
  fluidRow(
    radioButtons("timeformat", label=NULL,inline = TRUE,
                 c("Datetime", "Hour")),
    plotlyOutput("plot"),
    DTOutput("table")
  )
)

server <- function(input, output, session) {
  
  vals<-reactiveValues(
    selections=NULL
  )
  
  output$plot <- renderPlotly({
    df %>%
      plot_ly() %>%
      add_trace(x= ~t1, y = ~V1, type='scatter', mode='line', visible=TRUE) %>%
      layout(showlegend=FALSE)
  })
  
  nMarkers <- reactiveVal(0)
  Indices <- reactiveVal()
  
  observeEvent(event_data("plotly_click"),{
    d <- event_data("plotly_click")
    
    nMarkers(nMarkers() + 1)
    Indices(c(Indices(), d$pointNumber + 1))
    
    plotlyProxy("plot", session) %>%
      plotlyProxyInvoke(
        "addTraces", 
        list(
          x = list(d$x), y = list(d$y), type = 'scatter',
          marker = list(symbol='x', size=10, color='red')
        )
      )
  })
  
  observeEvent(input$timeformat,{
    t <- ifelse(input$timeformat == 'Datetime', "t1", "t2")
    plotlyProxy("plot", session) %>%
      plotlyProxyInvoke(
        "restyle", 
        list(
          x = list(df[[t]]), y = list(df$V1)
        ), 0
      )
    if(nMarkers() > 0) {
      plotlyProxy("plot", session) %>%
        plotlyProxyInvoke(
          "deleteTraces", seq_len(nMarkers())
        )
      x <- df[[t]][Indices()]
      y <- df$V1[Indices()]
      for(i in seq_len(nMarkers())) {
        plotlyProxy("plot", session) %>%
          plotlyProxyInvoke(
            "addTraces", 
            list(
              x = list(x[i]), y = list(y[i]), type = 'scatter',
              marker = list(symbol='x', size=10, color='red')
            )
          )
      }
    }
    
  }, ignoreInit = TRUE)
  
  output$table<-renderDataTable({
    vals$selections
  })   
  
}

shinyApp(ui,server)