I’m targeting a specific plotly trace with my R shiny inputs but I’d like to do so without referring to the data behind all the other traces. As seen below, updating the cylinder trace depends on an else
condition. I’d like to avoid that, as in my real data, I have many other traces, rather than the one here (the sphere trace).
library(shiny)
library(plotly)
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) {
output$plot <- renderPlotly({
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")
})
observeEvent(input$initialize, {
proxy <- plotlyProxy("plot", session)
plotlyProxyInvoke(proxy, "restyle", list(opacity = list(0.1)), list(name = "cylinder"))
})
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)