Search code examples
rshinyplotlyr-plotly

Removing traces by name using plotlyProxy (or accessing output schema in reactive context)

I am attempting to use the plotlyProxy() functionality (Documented here) to allow users of a shiny application to add and remove traces with minimal latency.

Adding traces proves to be relatively simple, but I'm having difficulty figuring out how to remove traces by name (I'm only seeing documented examples that remove by trace number).

Is there a way to remove traces by name using plotlyProxy()?

If not, is there a way that I can parse through the output object to derive what trace numbers are associated with a given name?

I can determine the associated trace number of a given name in an interactive R session using the standard schema indices, but when I attempt to apply the same logic in a shiny application I get an error: "Error in $.shinyoutput: Reading objects from shinyoutput object not allowed."

A minimal example is below. Neither observer watching the Remove button actually works, but they should give an idea for the functionality I'm trying to achieve.

library(shiny)
library(plotly)

ui <- fluidPage(
  textInput("TraceName", "Trace Name"),
  actionButton("Add","Add Trace"),
  actionButton("Remove","Remove Trace"),
  plotlyOutput("MyPlot")
)

server <- function(input,output,session) {

  ## Creaing the plot
  output$MyPlot <- renderPlotly({
    plot_ly() %>%
      layout(showlegend  = TRUE)
  })

  ## Adding traces is smooth sailing
  observeEvent(input$Add,{
    plotlyProxy("MyPlot", session) %>%
      plotlyProxyInvoke("addTraces", list(x = rnorm(10),y = rnorm(10),
                                          type = "scatter",mode = "markers",
                                          name = input$TraceName))
  })

  ## Ideal Solution (that does not work)
  observeEvent(input$Remove,{
    plotlyProxy("MyPlot", session) %>%
      plotlyProxyInvoke("deleteTraces", input$TraceName)
  })

  ## Trying to extract tracenames throws an error:
  ## Warning: Error in $.shinyoutput: Reading objects from shinyoutput object not allowed.
  observeEvent(input$Remove,{
    TraceNames <- unlist(lapply(seq_along(names(output$MyPlot$x$attrs)),
                                function(x) output$MyPlot$x$attrs[[x]][["name"]]))
    ThisTrace <- which(TraceNames == input$TraceName)

    plotlyProxy("MyPlot", session) %>%
      plotlyProxyInvoke("deleteTraces", ThisTrace)
  })

}

shinyApp(ui, server)

App Example

Solution

  • 3. Edit: Here is another approach using Shiny.addCustomMessageHandler and Plotly.deleteTraces directly in the onRender call instead of utilizing plotlyProxyInvoke:

    library(shiny)
library(plotly)
library(htmlwidgets)

js <- "function(el, x, data){
         var id = el.getAttribute('id');
         Shiny.addCustomMessageHandler('remove-trace', function(tracename) {
         function getTraceIndices(trace, traceindex) {
           if (trace.name === tracename) {
             Plotly.deleteTraces(id, traceindex);
           }
         }
         x.data.forEach(getTraceIndices);
         });
       }"

ui <- fluidPage(
  textInput("TraceName", "Trace Name"),
  actionButton("Add", "Add Trace"),
  actionButton("Remove", "Remove Trace"),
  plotlyOutput("MyPlot")
)

server <- function(input, output, session) {
  output$MyPlot <- renderPlotly({
    plot_ly(type = "scatter", mode = "markers") %>%
      layout(showlegend  = TRUE) %>% onRender(js) 
  })
  
  observeEvent(input$Add, {
    req(input$TraceName)
    plotlyProxy("MyPlot", session) %>%
      plotlyProxyInvoke("addTraces", list(x = rnorm(10), y = rnorm(10),
                                          type = "scatter", mode = "markers",
                                          name = input$TraceName))
  })
  
  observeEvent(input$Remove, {
    req(input$TraceName)
    session$sendCustomMessage("remove-trace", input$TraceName)
  })
}

shinyApp(ui, server)

    2. Edit: by now the Plotly.d3 object was removed from plotly. I updated the JS code accordingly (the trace indices are extracted from plotly's data object).

    1. Edit: using plotlyProxy:

    Update @SeGa, thanks for adding support to delete traces with duplicated names!

    Finally, I found a solution to realize the expected behaviour by adapting this answer. I'm receiving the trace.name / trace.index mapping by using onRender from library(htmlwidgets) after the remove-button is clicked:

    library(shiny)
library(plotly)
library(htmlwidgets)

js <- "function(el, x, inputName){
  el.on('plotly_redraw', function(eventdata) {
    var out = [];
    function getTraceIndices(trace, traceindex) {
      if (typeof trace.name !== 'undefined') {
        var tracename = trace.name ;
      } else {
        var tracename = '';
      }
      out.push([name=tracename, index=traceindex]);
    }
    x.data.forEach(getTraceIndices);
    Shiny.setInputValue(inputName, out);
  });
}"

ui <- fluidPage(
  textInput("TraceName", "Trace Name"),
  verbatimTextOutput("PrintTraceMapping"),
  actionButton("Add", "Add Trace"),
  actionButton("Remove", "Remove Trace"),
  plotlyOutput("MyPlot")
)

server <- function(input, output, session) {
  output$MyPlot <- renderPlotly({
    plot_ly(type = "scatter", mode = "markers") %>%
      layout(showlegend  = TRUE) %>% onRender(js, data = "TraceMapping") 
  })
  
  output$PrintTraceMapping <- renderPrint({unlist(input$TraceMapping)})
  
  observeEvent(input$Add, {
    req(input$TraceName)
    plotlyProxy("MyPlot", session) %>%
      plotlyProxyInvoke("addTraces", list(x = rnorm(10), y = rnorm(10),
                                          type = "scatter", mode = "markers",
                                          name = input$TraceName))
  })
  
  observeEvent(input$Remove, {
    req(input$TraceName, input$TraceMapping)
    traces <- matrix(input$TraceMapping, ncol = 2, byrow = TRUE)
    indices <- as.integer(traces[traces[, 1] == input$TraceName, 2])
    plotlyProxy("MyPlot", session) %>%
      plotlyProxyInvoke("deleteTraces", indices)
  })
}

shinyApp(ui, server)

    Result:

    Result

    Useful articles in this context:

    shiny js-events

    plotly addTraces

    plotly deleteTraces

    Solution for Shiny Modules using plotlyProxy:

    library(shiny)
library(plotly)
library(htmlwidgets)

js <- "function(el, x, data){
  $(document).on('shiny:inputchanged', function(event) {
    if (event.name.indexOf('Remove') > -1) {
      var out = [];
      function getTraceIndices(trace, traceindex) {
        if (typeof trace.name !== 'undefined') {
          var tracename = trace.name ;
        } else {
          var tracename = '';
        }
        out.push([name=tracename, index=traceindex]);
      }
      x.data.forEach(getTraceIndices);
      Shiny.setInputValue(data.ns + data.x, out);
    }
  });
}"

plotly_ui_mod <- function(id) {
  ns <- NS(id)
  tagList(
    textInput(ns("TraceName"), "Trace Name"),
    verbatimTextOutput(ns("PrintTraceMapping")),
    actionButton(ns("Add"), "Add Trace"),
    actionButton(ns("Remove"), "Remove Trace"),
    plotlyOutput(ns("MyPlot"))
  )
}

plotly_server_mod <- function(input, output, session) {
  sessionval <- session$ns("")
  
  output$MyPlot <- renderPlotly({
    plot_ly(type = "scatter", mode = "markers") %>%
      layout(showlegend  = TRUE) %>% onRender(js, data = list(x = "TraceMapping", 
                                                              ns = sessionval))
  })
  output$PrintTraceMapping <- renderPrint({unlist(input$TraceMapping)})
  observeEvent(input$Add, {
    req(input$TraceName)
    plotlyProxy("MyPlot", session) %>%
      plotlyProxyInvoke("addTraces", list(x = rnorm(10),y = rnorm(10),
                                          type = "scatter",mode = "markers",
                                          name = input$TraceName))
  })
  observeEvent(input$Remove, {
    req(input$TraceName, input$TraceMapping)
    traces <- matrix(input$TraceMapping, ncol = 2, byrow = TRUE)
    indices <- as.integer(traces[traces[, 1] == input$TraceName, 2])
    plotlyProxy("MyPlot", session) %>%
      plotlyProxyInvoke("deleteTraces", indices)
  })
}


ui <- fluidPage(
  plotly_ui_mod("plotly_mod")
)

server <- function(input, output, session) {
  callModule(plotly_server_mod, "plotly_mod")
}

shinyApp(ui, server)

    Previous Solution avoiding plotlyProxy:

    I came here via this question.

    You were explicitly asking for plotlyProxy() so I'm not sure if this is helpful to you, but here is a workaround to realize the expected behaviour via updating the data provided to plot_ly() instead of using plotlyProxy():

    library(shiny)
library(plotly)

ui <- fluidPage(
  selectizeInput(inputId="myTraces", label="Trace names", choices = NULL, multiple = TRUE, options = list('plugins' = list('remove_button'), 'create' = TRUE, 'persist' = TRUE, placeholder = "...add or remove traces")),
  plotlyOutput("MyPlot")
)

server <- function(input, output, session){
  
  myData <- reactiveVal()
  
  observeEvent(input$myTraces, {
    tmpList <- list()
    
    for(myTrace in input$myTraces){
      tmpList[[myTrace]] <- data.frame(name = myTrace, x = rnorm(10),y = rnorm(10))
    }
    
    myData(do.call("rbind", tmpList))
    
    return(NULL)
  }, ignoreNULL = FALSE)
  
  output$MyPlot <- renderPlotly({
    if(is.null(myData())){
      plot_ly(type = "scatter", mode = "markers")
    } else {
      plot_ly(myData(), x = ~x, y = ~y, color = ~name, type = "scatter", mode = "markers") %>%
        layout(showlegend  = TRUE)
    }
  })
}

shinyApp(ui, server)