在存在反应值的情况下动态添加和删除跟踪答案

【问题标题】：Dynamically add and remove trace in the presence of reactive values在存在反应值的情况下动态添加和删除跟踪
【发布时间】：2021-04-03 08:32:48
【问题描述】：

我的应用程序包含使用 R plotly 制作的曲面图，用户可以使用sliderInput 指定动态绘制等高线（实际上是 3D 散点图）的级别。因此，当用户单击应用程序的按钮时，当前轮廓线将被删除，并生成一条新轮廓线并将其放置在绘图上。我的问题；然而，plotlyProxy 和plotlyProxyInvoke 的使用并不重要——重新绘制表面图并重置视角，这正是我想要避免的。这是我的最小可重现代码：

library(shiny)
library(plotly)
library(isoband)

ui <- fluidPage(
  
  h1("My simple app"),
  
  sliderInput(
    inputId = "slider", label = "Select contour level", value = 1, min = 1, max = 40),
  
  actionButton(inputId = "btn", "OK"),
  
  plotlyOutput(outputId = "plot")
  
)

server <- function(input, output, session){
  
  rv <- reactiveValues()
  
  x <- y <- 0:100
  z <- outer(X = x, Y = y, function(x, y) x^0.2 * y^0.6)
  
  observeEvent(input$btn, ignoreInit = TRUE, {
    
    rv$iso <- isolines(x = x, y = y, z = z, levels = isolate({input$slider}))
    
    plotlyProxy("plot", session) %>%
      plotlyProxyInvoke(method = "deleteTraces", list(1)) %>% 
      plotlyProxyInvoke(
        method = "addTraces",
        list(
          type = "scatter3d",
          x = rv$iso[[1]]$x,
          y = rv$iso[[1]]$y,
          z = isolate({input$slider})
        )
      )

  })

  
  output$plot <- renderPlotly({
    
    rv$iso <- isolines(x = x, y = y, z = z, levels = isolate({input$slider}))
    
    plot_ly(
      type = "surface",
      x = x,
      y = y,
      z = z
    ) %>%
      add_trace(
        type = "scatter3d",
        x = rv$iso[[1]]$x,
        y = rv$iso[[1]]$y,
        z = isolate({input$slider})
      )
    
  })
  
  


}

shinyApp(ui = ui, server = server)

【问题讨论】：

标签： r shiny plotly r-plotly

【解决方案1】：

也许你正在寻找这个

ui <- fluidPage(
  
  h1("My simple app"),
  
  sliderInput(
    inputId = "slider", label = "Select contour level", value = 1, min = 1, max = 40),
  
  actionButton(inputId = "btn", "OK"),
  
  plotlyOutput(outputId = "plot")
  
)

server <- function(input, output, session){
  
  rv <- reactiveValues()
  
  x <- y <- 0:100
  z <- outer(X = x, Y = y, function(x, y) x^0.2 * y^0.6)
  
  observe({rv$iso <- isolines(x = x, y = y, z = z, levels = isolate({input$slider}))})
  
  observeEvent(input$slider, ignoreInit = TRUE, {
    
    rv$iso <- isolines(x = x, y = y, z = z, levels = isolate({input$slider}))
    
    plotlyProxy("plot", session) %>%
      
      plotlyProxyInvoke(
        method = "addTraces",
        list(
          type = "scatter3d",
          x = rv$iso[[1]]$x,
          y = rv$iso[[1]]$y,
          z = isolate({input$slider})
        )
      )
    
  })
  
  observeEvent(input$btn, ignoreInit = TRUE, {
    
    plotlyProxy("plot", session) %>%
      plotlyProxyInvoke(method = "deleteTraces", list(1)) 
    
  })
  
  
  output$plot <- renderPlotly({
    
    plot_ly(
      type = "surface",
      x = x,
      y = y,
      z = z
    ) %>%
      add_trace(
        type = "scatter3d",
        x = rv$iso[[1]]$x,
        y = rv$iso[[1]]$y,
        z = isolate({input$slider})
      )
    
  })
  
}

shinyApp(ui = ui, server = server)

【讨论】：

我刚刚测试了你的代码，当绘制新的轮廓线时，视角仍然重置。

【解决方案2】：

解决方案由 RStudio 社区的@nirgrahamuk 提供：

library(shiny)
library(plotly)
library(isoband)

ui <- fluidPage(
  h1("My simple app"),
  sliderInput(
    inputId = "slider",
    label = "Select contour level",
    value = 1,
    min = 1,
    max = 40
  ),
  actionButton(inputId = "btn", "OK"),
  plotlyOutput(outputId = "plot")
)

server <- function(input, output, session) {
  x <- y <- 0:100
  z <- outer(X = x, Y = y, function(x, y) x^0.2 * y^0.6)
  # precompute iso levels
  iso <- isolines(x = x, y = y, z = z, levels = 1:40)


  observeEvent(input$btn,
    ignoreInit = TRUE,
    {
      lvl <- input$slider
      mytrace <- list(
        type = "scatter3d",
        mode = "markers",
        x = iso[[lvl]]$x,
        y = iso[[lvl]]$y,
        z = rep(lvl, length(iso[[lvl]]$id))
      )
      p1 <- plotlyProxy("plot", session)

      plotlyProxyInvoke(p1,
        method = "deleteTraces",
        list(-1)
      )
      plotlyProxyInvoke(p1,
        method = "addTraces",
        list(mytrace)
      )
    }
  )


  output$plot <- renderPlotly({
    isolate({
      lvl <- input$slider
      plot_ly(
        type = "surface",
        x = x,
        y = y,
        z = z
      ) %>%
        add_trace(
          type = "scatter3d",
          mode = "markers",
          x = iso[[lvl]]$x,
          y = iso[[lvl]]$y,
          z = lvl
        )
    })
  })
}
shinyApp(ui, server)

【讨论】：