使用plotlyProxy按名称移除跟踪(或访问React式上下文中的输出模式)

j1dl9f46  于 2022-12-20  发布在  React
关注(0)|答案(3)|浏览(235)

我尝试使用plotlyProxy()功能(Documented here)来允许优秀应用程序的用户以最小的延迟添加和删除跟踪。
添加跟踪被证明是相对简单的,但是我很难弄清楚如何按名称删除跟踪 (我只看到了按跟踪编号删除的文档示例)
是否有办法使用plotlyProxy()按名称删除跟踪?
如果没有,是否有一种方法可以解析输出对象,以导出与给定名称关联的跟踪号?
我可以使用标准模式索引在交互式R会话中确定给定名称的关联跟踪号,但是当我试图在一个出色的应用程序中应用相同的逻辑时,我得到一个错误:* “$.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)

3ks5zfa0

3ks5zfa01#

编辑使用plotlyProxy
更新@SeGa,感谢您添加删除同名轨迹的支持!

最后,我找到了一个通过修改answer来实现预期行为的解决方案。trace.name单击remove-button后,我使用onRenderlibrary(htmlwidgets)接收www.example.com/trace.indexMap:

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
绘图添加轨迹
绘图删除轨迹

采用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)

以前的解决方案避免plotlyProxy

我是通过这个问题来到这里的。
您明确要求使用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)
but5z9lq

but5z9lq2#

找不到痕迹的names属性,我想deleteTrace函数不能按名称删除,它只是根据引用按索引删除
我尝试为Shiny实现一些东西,它在 Dataframe 中记录添加的跟踪,并为它们添加索引。对于删除,它将给定的名称与 Dataframe 匹配,并将这些索引提供给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)
vom3gejh

vom3gejh3#

看起来Plotly.D3方法已经过时了,在上面的代码中不再起作用。我可以用下面的代码复制一个简单的解决方案。

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)

相关问题