在闪亮上动态添加情节痕迹

Posted 2023-02-14

【中文标题】在闪亮上动态添加情节痕迹

【英文标题】：Add plotly traces dynamically on shiny

【发布时间】：2019-05-18 06:15:57

【问题描述】：

我正在构建一个应用程序，允许用户使用 selectInput 在绘图图上动态添加和删除轨迹。

我曾尝试使用 plotly 包中的 plotlyProxy() 和 plotlyProxyInvoke() 无济于事。

下面是我的基本代码：

  library(shiny)
  library(shinydashboard)
  library(plotly)


    ui <- dashboardPage(
       dashboardHeader(),
       dashboardSidebar(
       sidebarMenu(
        menuItem("Search", tabName = "Tabs", icon = icon("object-ungroup"))

        )
       ),
      dashboardBody(
      tabItem(tabName = "Tabs",
             fluidRow(
             column(width=3, 
                 box(
                   title="SELECT ",
                   solidHeader=TRUE,
                   collapsible=TRUE,
                   width=NULL,
                   selectInput(
                     inputId="Player",
                     selected = NULL, multiple = TRUE,
                     label=" Choose Player", 
                     choices=c("Messi", "Suarez", "Ronaldo" )),
                   selectInput(
                     inputId="Delete",
                     selected = NULL, multiple = TRUE,
                     label=" Choose Player", 
                     choices=c("Messi", "Suarez", "Ronaldo" )),
                   submitButton("Select")
                 )
          ),

          column( width=9,
                  tabBox(
                    ,
                    tabPanel("tab1", 
                             plotlyOutput("Plot1")
                    )))))))

     server <- function(input, output, session) 
           output$Plot1 <-  renderPlotly(

          goals <- data.frame(Name = c("Messi", "Suarez", "Ronaldo", "Messi", "Suarez", "Ronaldo", "Messi", "Suarez", "Ronaldo" ), 
                    Number= c(47, 35, 40, 49, 32, 31, 51, 49, 44 ),
                    Year = c("2018","2018","2018", "2017", "2017", "2017", "2016","2016","2016")
   )  

         plot_ly(goals, x = ~Year, y = ~Number, type = 'scatter', mode = 'lines', color = ~input$Player )%>% layout(showlegend = TRUE)%>%
  layout(title = 'Number of goals')
 )

     # plotly.addTraces
   observeEvent(input$Player, 
       plotlyProxy("Plot1", session) %>%
        plotlyProxyInvoke("addTraces", list(x = ~Year, 
                                      y = ~Number,
                                      type = 'scatter',
                                      mode = 'lines'))
         )

       # plotly.deleteTraces
       observeEvent(input$Delete, 
        plotlyProxy("Plot1", session) %>%
        plotlyProxyInvoke("deleteTraces")
         )
       
   shinyApp(ui, server)

有没有办法动态地使用 plotlyProxyInvoke() 来添加和删除跟踪，而无需使用 addTrace() 对跟踪进行硬编码？

【问题讨论】：

您可以轻松添加跟踪，但删除它们有点棘手，因为您只能通过索引删除跟踪。有一个与此相关的当前plotly-github issue，它还链接到*** question，我试图解决它，但它并没有按预期工作。

@SeGa 谢谢。我会检查你的解决方案。

【参考方案1】：

这是一个避免plotlyProxy() 的解决方案，方法是在将data.frame 传递给plot_ly 之前对其进行过滤：

library(shiny)
library(shinydashboard)
library(plotly)


ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(
    sidebarMenu(
      menuItem("Search", tabName = "Tabs", icon = icon("object-ungroup"))

    )
  ),
  dashboardBody(
    tabItem(tabName = "Tabs",
            fluidRow(
              column(width=3, 
                     box(
                       title="SELECT ",
                       solidHeader=TRUE,
                       collapsible=TRUE,
                       width=NULL,
                       selectizeInput(
                         inputId="Player",
                         selected = NULL, multiple = TRUE,
                         label=" Choose Player", 
                         choices=c("Messi", "Suarez", "Ronaldo" ), options = list('plugins' = list('remove_button')))
                     )
              ),

              column( width=9,
                      tabBox(
                        ,
                        tabPanel("tab1", 
                                 plotlyOutput("Plot1")
                        )))))))

server <- function(input, output, session) 
  output$Plot1 <-  renderPlotly(

    goals <- data.frame(Name = c("Messi", "Suarez", "Ronaldo", "Messi", "Suarez", "Ronaldo", "Messi", "Suarez", "Ronaldo" ), 
                        Number= c(47, 35, 40, 49, 32, 31, 51, 49, 44 ),
                        Year = c("2018","2018","2018", "2017", "2017", "2017", "2016","2016","2016")
    )  

    filteredGoals <- reactive(
      goals[goals$Name %in% input$Player, ]
    )

    plot_ly(filteredGoals(), x = ~Year, y = ~Number, type = 'scatter', mode = 'lines', color = ~Name)%>% layout(showlegend = TRUE) %>%
      layout(title = 'Number of goals')
  )

shinyApp(ui, server)

【讨论】：

对于未来的读者：here 是使用plotlyProxy() 的解决方案