使用plotlyProxy按名称删除跟踪(或在 react 性上下文中访问输出模式)

Question

我正在尝试使用 plotlyProxy() 功能 ( Documented here ) 来允许 Shiny 应用程序的用户以最小的延迟添加和删除跟踪。

事实证明，添加跟踪相对简单，但我很难弄清楚如何按名称删除跟踪(我只看到按跟踪编号删除的记录示例)。

>

有没有办法使用plotlyProxy()按名称删除痕迹？

如果没有，是否有一种方法可以解析输出对象以得出与给定名称关联的跟踪号？

我可以使用标准模式索引确定交互式 R session 中给定名称的关联跟踪号，但是当我尝试在 Shiny 的应用程序中应用相同的逻辑时，我收到错误:“$ 中的错误” .shinyoutput:不允许从shinyoutput对象读取对象。”

下面是一个最小的示例。观看 Remove 按钮的观察者实际上都不起作用，但他们应该对我试图实现的功能有一个想法。

<小时/>

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

使用 plotlyProxy 编辑:

更新@SeGa，感谢您添加对删除重复名称的跟踪的支持!

最后，我找到了一个解决方案，通过调整此 answer 来实现预期的行为。 。单击删除按钮后，我通过使用 library(htmlwidgets) 中的 onRender 接收trace.name/trace.index 映射:

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)

结果:

在这方面有用的文章:

shiny js-events

plotly addTraces

plotly deleteTraces

<小时/>

使用 plotlyProxy 的 Shiny 模块解决方案:

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)

<小时/>

以前的解决方案避免 plotlyProxy:

我是通过这个question来到这里的.

您明确要求 plotlyProxy() 所以我不确定这对您是否有帮助，但这里有一个解决方法，可以通过更新提供给 的数据来实现预期行为plot_ly() 而不是使用 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)