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

Question

我的应用程序包含一个用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)

Answer 1

该解决方案由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)