使用plotlyProxy在数据变化时添加多条trace

Question

感谢这个问题：我现在明白了如何去除痕迹。在这种情况下，我只是删除了 0:2，但我可以将其更改为即 array(O:unique(factor(df$group))) 以删除我的模型在之前的运行中创建的许多组。

然而，我一直无法弄清楚的是如何添加多条轨迹，目标列中的每个因素 1，并用 THECOLORS

中的颜色给它们着色

library("shiny")
library("plotly")

rock[,2] <- sample(c('A', 'B', 'C'), 48, replace = T)
THECOLORS <- c('#383838', '#5b195b','#1A237E', '#000080', '#224D17', '#cccc00', '#b37400',  '#990000')

ui <- fluidPage(
  selectInput("dataset", "Choose a dataset:", choices = c("mtcars","rock")),

  plotlyOutput("Plot1")
)


server <- function(input, output, session) {


  dataSource <- reactive({switch(input$dataset,"rock" = rock,"mtcars" = mtcars)})

  output$Plot1 <-  renderPlotly({plot_ly(mtcars, x = ~mpg, y = ~hp, type = 'scatter', mode = 'markers', color = as.factor(mtcars$cyl), colors = THECOLORS) })

  observeEvent(input$dataset, {
    f <- list(
      family = "Courier New, monospace",
      size = 18,
      color = "#7f7f7f"
    )
    x <- list(
      title = "x Axis",
      titlefont = f, 
      range = c(0,(max(dataSource()[,1])+ 0.1*max(dataSource()[,1])))
    )
    y <- list(
      title = "y Axis",
      titlefont = f,
      range = c(0,(max(dataSource()[,4])+ 0.1*max(dataSource()[,4])))
    )
    plotlyProxy("Plot1", session) %>%
      plotlyProxyInvoke("deleteTraces",array(0:2)) %>% 
      # lapply(unique(dataSource()[,2], function(x) {  data <- dataSource()[which(dataSource()[,2] == x)],
      #                                   plotlyProxyInvoke("addTraces", 
      #                                     
      #                                     x = data()[,1],
      #                                     y = data()[,4],
      #                                     type = 'scatter',
      #                                     mode = 'markers')}) %>%

      plotlyProxyInvoke("relayout", list(xaxis = x, yaxis = y))
  })
}

shinyApp(ui, server)

Answer 1

基本上当使用 plotlyProxy 而不是使用 "addTraces" 的 plotlyProxyInvoke 时，"addTraces" 用于添加更多跟踪。您必须创建一个列表列表，每个内部列表将包含每个跟踪的详细信息。在您要添加许多跟踪的情况下，purrr 包中的一些函数可能有助于创建定义跟踪的列表列表。

看看下面的代码。这是一个非常简化的例子，只添加了两条轨迹，但是列表方法的列表就在那里。关于您对速度的评论，也许您可以仅在需要时加载数据，如果您的应用概念允许的话，可以部分加载数据...

代码：

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

    ui <- fluidPage(
            selectInput("dataset", "Choose a dataset:", choices = c("rock", "mtcars")),

            plotlyOutput("Plot1")
    )


    server <- function(input, output, session) {



            output$Plot1 <-  renderPlotly({plot_ly(data = rock, x = ~area, 
                                                   y =~peri, mode = 'markers', type = 'scatter')})

            observeEvent(input$dataset, {
                    if (input$dataset == "rock") {
                            f <- list(
                                    family = "Courier New, monospace",
                                    size = 18,
                                    color = "#7f7f7f"
                            )
                            x <- list(
                                    title = "Area",
                                    titlefont = f, 
                                    range = c(0, max(rock$area))
                            )
                            y <- list(
                                    title = "Peri/Perm",
                                    titlefont = f,
                                    range = c(0, max(rock$peri))
                            )    
                            plotlyProxyInvoke(plotlyProxy("Plot1", session), "addTraces", list(list( 
                                    x = rock$area,
                                    y = rock$peri,
                                    type = 'scatter',
                                    mode = 'markers',
                                    marker = list(size = 10,
                                                  color = 'rgba(255, 182, 193, .9)',
                                                  line = list(color = 'rgba(0, 255, 0, .3)',
                                                              width = 2))
                            ),
                            list( 
                                    x = rock$area,
                                    y = rock$perm,
                                    type = 'scatter',
                                    mode = 'markers',
                                    marker = list(size = 10,
                                                  color = 'rgba(255, 182, 193, .9)',
                                                  line = list(color = 'rgba(152, 0, 0, .8)',
                                                              width = 2))
                            ))
                            ) 
                            plotlyProxy("Plot1", session) %>%
                                    plotlyProxyInvoke("deleteTraces", list(as.integer(0))) %>%
                                    plotlyProxyInvoke("relayout", list(xaxis = x, yaxis = y))
                    } else {
                            f <- list(
                                    family = "Courier New, monospace",
                                    size = 18,
                                    color = "#7f7f7f"
                            )
                            x <- list(
                                    title = "hp",
                                    titlefont = f, 
                                    range = c(0, max(mtcars$hp))
                            )
                            y <- list(
                                    title = "mpg/cyl",
                                    titlefont = f,
                                    range = c(0, max(mtcars$mpg))
                            ) 
                            plotlyProxyInvoke(plotlyProxy("Plot1", session), "addTraces", list(list( 
                                    x = mtcars$hp,
                                    y = mtcars$mpg,
                                    type = 'scatter',
                                    mode = 'markers',
                                    marker = list(size = 10,
                                                  color = 'rgba(255, 182, 193, .9)',
                                                  line = list(color = 'rgba(0, 255, 0, .3)',
                                                              width = 2))
                            ),
                            list( 
                                    x = mtcars$hp,
                                    y = mtcars$cyl,
                                    type = 'scatter',
                                    mode = 'markers',
                                    marker = list(size = 10,
                                                  color = 'rgba(255, 182, 193, .9)',
                                                  line = list(color = 'rgba(152, 0, 0, .8)',
                                                              width = 2))
                            ))
                            )   
                            plotlyProxy("Plot1", session) %>%
                                    plotlyProxyInvoke("deleteTraces", list(as.integer(0))) %>%
                                    plotlyProxyInvoke("relayout", list(xaxis = x, yaxis = y))
                    }
            })
    }

    shinyApp(ui, server)

使用plotlyProxy在数据变化时添加多条trace

Use plotlyProxy to add multiple traces when data changes

r

shiny

r-plotly

plotly.js