如何使用plotlyProxy修改指定Plotly轨迹且不关联其他轨迹数据

我正在通过R Shiny输入定位特定的Plotly轨迹，但希望操作时无需引用所有其他轨迹背后的数据。如下代码所示，当前更新圆柱轨迹依赖于else条件，而我的实际数据中存在大量其他轨迹（而非示例中的单个球体轨迹），因此希望避免这种写法。

library(shiny)
library(plotly)
library(purrr)

plot_cylinder <- function(x, y, z, radius, height, color = 'red') {
  theta <- seq(0, 2*pi, length.out = 30)
  z_cyl <- seq(z, z + height, length.out = 2)
  x_cyl <- outer(x + radius * cos(theta), rep(1, length(z_cyl)))
  y_cyl <- outer(y + radius * sin(theta), rep(1, length(z_cyl)))
  z_cyl <- outer(rep(1, length(theta)), z_cyl)
  
  list(
    type = "surface",
    x = x_cyl,
    y = y_cyl,
    z = z_cyl,
    colorscale = list(c(0, color), c(1, color))
  )
}

plot_sphere <- function(x, y, z, r, color = 'blue') {
  theta <- seq(0, 2*pi, length.out = 30)
  phi <- seq(0, pi, length.out = 30)
  x_sphere <- x + r * outer(cos(theta), sin(phi))
  y_sphere <- y + r * outer(sin(theta), sin(phi))
  z_sphere <- z + r * outer(rep(1, length(theta)), cos(phi))
  
  list(x = x_sphere, y = y_sphere, z = z_sphere, color = color)
}

# Static sphere data
sphere_radius <- 7.24
sphere_data <- plot_sphere(0, 0, 10, sphere_radius)

cylinder_data <- plot_cylinder(0, 0, 0, 3, 10)

ui <- fluidPage(
  titlePanel("Cylinder Plotting"),
  sidebarLayout(
    sidebarPanel(
      sliderInput("radius", "Cylinder Radius:", min = 1, max = 10, value = 3),
      sliderInput("height", "Cylinder Height:", min = 1, max = 20, value = 10),
      actionButton("initialize", "Initialize Cylinder")
    ),
    mainPanel(
      plotlyOutput("plot")
    )
  )
)

server <- function(input, output, session) {
  
  plot <- plot_ly() |> 
    add_surface(x = sphere_data$x, y = sphere_data$y, 
                z = sphere_data$z, colors = sphere_data$color, 
                opacity = 0.5, name = "sphere") |> 
    add_surface(x = cylinder_data$x, y = cylinder_data$y, 
                z = cylinder_data$z, colorscale = cylinder_data$colorscale, 
                opacity = 0, name = "cylinder")
  
  pb <- plotly_build(plot)
  traces <- map(pb$x$data, "name")
  
  output$plot <- renderPlotly({
    plot
  })
  
  observeEvent(input$initialize, {
    proxy <- plotlyProxy("plot", session)
    
    plotlyProxyInvoke(proxy, "restyle", list(
      opacity = lapply(traces, function(name) if(name %in% "cylinder") 0.1 else 0.5)
      ))
  })
  
  observeEvent(c(input$radius, input$height), {
    proxy <- plotlyProxy("plot", session)
    
    # Get the updated cylinder trace
    cylinder_data <- plot_cylinder(0, 0, 0, input$radius, input$height)
    
    # Update the trace with the new x, y, z values
    plotlyProxyInvoke(proxy, "restyle", list(
      x = lapply(traces, function(name) if(name %in% "cylinder") cylinder_data$x else sphere_data$x),
      y = lapply(traces, function(name) if(name %in% "cylinder") cylinder_data$y else sphere_data$y),
      z = lapply(traces, function(name) if(name %in% "cylinder") cylinder_data$z else sphere_data$z)
    ))
  })
}

shinyApp(ui = ui, server = server)

核心思路是利用Plotly Proxy的目标轨迹索引精准更新指定轨迹，无需遍历所有轨迹并处理else分支。具体实现如下：

server <- function(input, output, session) {
  
  plot <- plot_ly() |> 
    add_surface(x = sphere_data$x, y = sphere_data$y, 
                z = sphere_data$z, colors = sphere_data$color, 
                opacity = 0.5, name = "sphere") |> 
    add_surface(x = cylinder_data$x, y = cylinder_data$y, 
                z = cylinder_data$z, colorscale = cylinder_data$colorscale, 
                opacity = 0, name = "cylinder")
  
  pb <- plotly_build(plot)
  # 获取cylinder轨迹的索引（Plotly JS端索引从0开始，需转换R的1起始索引）
  cylinder_index <- which(map_chr(pb$x$data, "name") == "cylinder") - 1
  
  output$plot <- renderPlotly({
    plot
  })
  
  observeEvent(input$initialize, {
    proxy <- plotlyProxy("plot", session)
    
    # 仅更新目标轨迹的opacity，其他轨迹不受影响
    plotlyProxyInvoke(proxy, "restyle", 
                      list(opacity = 0.1),
                      cylinder_index
                      )
  })
  
  observeEvent(c(input$radius, input$height), {
    proxy <- plotlyProxy("plot", session)
    
    cylinder_data <- plot_cylinder(0, 0, 0, input$radius, input$height)
    
    # 仅更新cylinder轨迹的x/y/z数据
    plotlyProxyInvoke(proxy, "restyle", 
                      list(
                        x = list(cylinder_data$x),
                        y = list(cylinder_data$y),
                        z = list(cylinder_data$z)
                      ),
                      cylinder_index
                      )
  })
}

关键说明 #

• plotlyProxyInvoke的第三个参数可指定单个或多个轨迹索引，仅对目标轨迹应用更新，无需处理其他轨迹的默认值。
• 注意索引转换：R中which返回1起始位置，而Plotly JavaScript端轨迹索引从0开始，因此需要减1适配。
• 更新x/y/z这类数组型属性时，要将数据包裹在list()中，符合Plotly JS API的参数格式。

内容的提问来源于stack exchange，提问作者its.me.adam