使用plotlyProxy在数据更改时添加多个跟踪

时间:2018-05-14 11:24:21

标签: r shiny r-plotly plotly.js

感谢这个问题:SO-Q我现在已经了解了如何删除痕迹。在这种情况下,我只是删除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)

1 个答案:

答案 0 :(得分: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)