在闪亮上动态添加绘图痕迹

Question

我正在构建一个应用程序，允许用户使用 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(
                    width="100%",
                    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() 对跟踪进行硬编码？

Answer 1

这里有一个解决方案，通过在将

plotlyProxy()

传递给

data.frame

之前过滤它来避免

plot_ly

：

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

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")
)

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(width = "100%",
                                                          tabPanel(
                                                            "tab1",
                                                            plotlyOutput("Plot1")
                                                          )))
                                          ))))

server <- function(input, output, session) {
  filteredGoals <- reactive({
    goals[goals$Name %in% input$Player, ]
  })
  
  output$Plot1 <- renderPlotly({
    plot_ly(filteredGoals(), x = ~Year, y = ~Number, type = 'scatter', mode = 'lines', color = ~Name)%>% layout(showlegend = TRUE) %>%
      layout(title = 'Number of goals')
  })
}

shinyApp(ui, server)