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

Question

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)

Answer 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){
  var id = el.getAttribute('id');
  var d3 = Plotly.d3;
  $(document).on('shiny:inputchanged', function(event) {
    if (event.name === 'Remove') {
      var out = [];
      d3.select('#' + id + ' g.legend').selectAll('.traces').each(function(){
        var trace = d3.select(this)[0][0].__data__[0].trace;
        out.push([name=trace.name, index=trace.index]);
      });
      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:

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){
  var id = el.getAttribute('id');
  var d3 = Plotly.d3;
  $(document).on('shiny:inputchanged', function(event) {
    if (event.name.indexOf('Remove') > -1) {
      var out = [];
      d3.select('#' + id + ' g.legend').selectAll('.traces').each(function(){
        var trace = d3.select(this)[0][0].__data__[0].trace;
        out.push([name=trace.name, index=trace.index]);
      });
      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)

Answer 2

I couldn't find the names attributes of the traces, and I think the deleteTrace function is not able to delete by name. Based on the reference it just deletes based on index.

I tried to implement something for Shiny, which records the added traces in a dataframe and adds an index to them. For deletion, it matches the given names with the dataframe and gives those indeces to the delete method of plotlyProxyInvoke, but it is not working correctly. Maybe someone could add some insight into why this is happening?

One problem seems to be the legend, which is showing wrong labels after deletion and I dont think that plotly and R/shiny are keeping the same indices of the traces, which leads to strange behaviour. So this code definitly needs some fixing.

--
I included a small JQuery snippet, which records all the traces of the plot and sends them to a reactiveVal(). Interestingly, it differs from the data.frame, that listens to the AddTraces event. There will always be one remaining trace in the plot.

library(shiny)
library(plotly)
library(shinyjs)

ui <- fluidPage(
  useShinyjs(),
  tags$head(tags$script(HTML(
    "$(document).on('shiny:value', function(event) {
    var a = $('.scatterlayer.mlayer').children();
    if (a.length > 0) {
    var text = [];
    for (var i = 0; i < a.length; i++){
    text += a[i].className.baseVal + '<br>';
    }
    Shiny.onInputChange('plotlystr', text);
    }
    });"
))),
textInput("TraceName", "Trace Name"),
actionButton("Add","Add Trace"),
actionButton("Remove","Remove Trace by Name"),
plotlyOutput("MyPlot"),
splitLayout(
  verbatimTextOutput("printplotly"),
  verbatimTextOutput("printreactive")
)
  )

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

  ## Reactive Plot
  plt <- reactive({
    plot_ly() %>%
      layout(showlegend  = T)
  })
  ## Reactive Value for Added Traces
  addedTrcs <- reactiveValues(tr = NULL, id = NULL, df = NULL)

  ## Creaing the plot
  output$MyPlot <- renderPlotly({
    plt()
  })

  ## Adding traces is smooth sailing
  observeEvent(input$Add,{
    req(input$TraceName)
    plotlyProxy("MyPlot", session) %>%
      plotlyProxyInvoke("addTraces", list(x = rnorm(10),y = rnorm(10),
                                          type = "scatter",mode = "markers", colors ="blue",
                                          name = input$TraceName))
  })
  ## Adding trace to reactive
  observeEvent(input$Add, {
    req(input$TraceName)
    x <- input$TraceName
    addedTrcs$id <- c(addedTrcs$id, length(addedTrcs$id))
    addedTrcs$tr <- c(addedTrcs$tr, x)
    addedTrcs$df <- data.frame(id=addedTrcs$id, tr=addedTrcs$tr, stringsAsFactors = F)
  })

  ## Remove Trace from Proxy by NAME
  observeEvent(input$Remove,{
    req(input$TraceName %in% addedTrcs$tr)
    ind = which(addedTrcs$df$tr == input$TraceName)
    ind = addedTrcs$df[ind,"id"]

    plotlyProxy("MyPlot", session) %>%
      plotlyProxyInvoke("deleteTraces", as.integer(ind))
  })  

  ## Remove Trace from Reactive
  observeEvent(input$Remove, {
    req(input$TraceName %in% addedTrcs$df$tr)  

    whichInd <- which(addedTrcs$tr == input$TraceName)
    addedTrcs$df <- addedTrcs$df[-whichInd,]
    addedTrcs$id <- addedTrcs$id[-whichInd]
    addedTrcs$tr <- addedTrcs$tr[-whichInd]

    req(nrow(addedTrcs$df)!=0)
    addedTrcs$df$id <- 0:(nrow(addedTrcs$df)-1)
  })


  tracesReact <- reactiveVal()
  observe({
    req(input$plotlystr)
    traces <- data.frame(traces=strsplit(input$plotlystr, split = "<br>")[[1]])
    tracesReact(traces)
  })
  output$printplotly <- renderPrint({
    req(tracesReact())
    tracesReact()
  })

  ## Print Reactive Value (added traces)
  output$printreactive <- renderPrint({
    req(addedTrcs$df)
    addedTrcs$df
  })
}

shinyApp(ui, server)

Answer 3

It appears the Plotly.D3 method has been depreciated and no longer works in the above code. I was able to replicate a simple solution with the below code.

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

js <- "function(el){
  $(document).on('shiny:inputchanged', function(event) {
    if (event.name === 'Remove') {
      var traceName = document.getElementById('TraceName').value
      var plotlyData = document.getElementById('MyPlot').data
      plotlyData.forEach(function (item, index) {
        if (item.name === traceName){
          Plotly.deleteTraces('MyPlot', index);
        }
      });
      
    }
  });
}"

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

server <- function(input, output, session) {
  
  output$MyPlot <- renderPlotly({
    print("renderPlotlyRan")
    plot_ly(type = "scatter", mode = "markers") %>%
      add_markers(x = rnorm(10),y = rnorm(10), name = "Trace1") %>% 
      add_markers(x = rnorm(10),y = rnorm(10), name = "Trace2") %>% 
      add_markers(x = rnorm(10),y = rnorm(10), name = "Trace3") %>% 
      add_markers(x = rnorm(10),y = rnorm(10), name = "Trace4") %>% 
      layout(showlegend  = TRUE) %>% 
      htmlwidgets::onRender(x = ., jsCode = js) 
  })
  
}

shinyApp(ui, server)