使用plotlyProxy按名称删除跟踪（或在响应上下文中访问输出模式）

Question

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

添加跟踪证明相对简单，但我很难弄清楚如何通过名称​​删除跟踪（我只看到通过跟踪号删除的文档示例）。

有没有办法使用plotlyProxy()按名称删除跟踪？

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

我可以使用标准架构索引确定交互式R会话中给定名称的关联跟踪编号，但是当我尝试在闪亮的应用程序中应用相同的逻辑时，我收到错误：“$ in Error .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

我是通过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)

Answer 2

我找不到跟踪的名称属性，并且我认为deleteTrace函数无法按名称删除。根据引用，它只会删除基于index 的。

我尝试为Shiny实现一些功能，该功能将添加的跟踪记录在一个数据帧中并为其添加索引。对于删除，它会将给定名称与数据帧进行匹配，并将那些索引赋予plotlyProxyInvoke的delete方法，但无法正常工作。 也许有人可以对为什么发生这种情况有一些了解？

一个问题似乎就是传说，它在删除后显示了错误的标签，我不认为plotly和R / shiny保持相同的痕迹索引，这会导致奇怪的行为。因此，此代码肯定需要修复。

-
我包括一个小的JQuery代码段，该代码段记录了绘图的所有轨迹并将其发送到reactiveVal()。有趣的是，它不同于侦听AddTraces事件的data.frame。在图中将始终有一条剩余的迹线。

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)