向动态 selectInputs 添加“ALL”选项答案

【问题标题】：Adding an "ALL" option to dynamic selectInputs向动态 selectInputs 添加“ALL”选项
【发布时间】：2019-02-22 13:30:44
【问题描述】：

我正在尝试在我的两个动态链接的 selectInput 小部件中添加一个 ALL 选项，该小部件会过滤到我的主面板中的图表。基本上，我希望用户选择一个服务，例如在线或邮购，或所有服务，与 Prof.Los 列类似，我希望用户选择盈利或亏损，或两者的总和。

当两个输入动态链接时，我不确定如何添加这个额外的选项。所以我的问题是，如何在两个下拉菜单中包含一个按所有变量过滤数据的选项？

我的图书馆和数据：

library("shiny")
library("plotly")
library("tidyverse")
library("dplyr")

data <- data.frame(Services = c("Online","Online","Online","Online","Online","Online","Online","Online","Online", "Online","Online","Online","Mail-order","Mail-order","Mail-order","Mail-order","Mail-order","Mail-order","Mail-order","Mail-order","Mail-order","Mail-order","Mail-order","Mail-order","Shop","Shop","Shop","Shop","Shop","Shop","Shop","Shop","Shop","Shop","Shop","Shop"),
               Month = c("2013-01-01","2013-02-01","2013-03-01","2013-04-01","2013-05-01","2013-06-01","2013-07-01","2013-08-01","2013-09-01","2013-10-01","2013-11-01","2013-12-01","2013-01-01","2013-02-01","2013-03-01","2013-04-01","2013-05-01","2013-06-01","2013-07-01","2013-08-01","2013-09-01","2013-10-01","2013-11-01","2013-12-01","2013-01-01","2013-02-01","2013-03-01","2013-04-01","2013-05-01","2013-06-01","2013-07-01","2013-08-01","2013-09-01","2013-10-01","2013-11-01","2013-12-01"),
               Sales = c(40,50,20,30,40,50,200,100,250,100, 120,130,40,80,20,30,30,50,400,100,150,100,75,50,100,50,700,30,40,50,100,120,220,100,75,150),
               Prof.Los = c("Profit","Loss","Profit","Profit","Loss","Loss","Loss","Profit","Profit","Loss","Loss","Profit","Profit","Loss","Profit","Loss","Profit","Loss","Loss","Loss","Profit","Loss","Loss","Profit","Profit","Profit","Loss","Loss","Loss","Profit","Profit","Loss","Loss","Loss","Profit","Loss"))

我的代码：

用户界面

ui <- fluidPage(
   # App title ----
   titlePanel(h1("Analyser tool")),
   # Sidebar layout with input and output definitions ----
   sidebarLayout(
      sidebarPanel(
                   # Input: Select service type ----
                   uiOutput("services"),
                   uiOutput("rev")
      ),
      # Main panel for displaying outputs ----
      mainPanel(
         # Output: Tabset w/ plot, summary, and table ----
         tabsetPanel(type = "tabs",
                     tabPanel("Bar Chart", plotlyOutput("Plot", height = "450px"))
         )
      )
   ))

服务器

server <- function(input, output) {

   # Service analyser reactive dataset
   output$services = renderUI({
      selectInput("services",
                  "Select services:",
                  choices = unique(data$Services))
   })

  ServiceSub <- reactive({
      data %>%
         filter(Services == input$services)
   })

  output$rev = renderUI({

     selectInput(inputId = "rev",
                 label = "Profit/loss",
                 choices = unique(ServiceSub()[,"Prof.Los"]),
                 selected = unique(ServiceSub()[,"Prof.Los"]))
  })

  RevSub <- reactive({
     req(input$services)
     filter(ServiceSub(), Prof.Los %in% input$rev)

  })

  output$Plot = renderPlotly({

     # plotly code
     plot_ly(RevSub(), x = ~Month, y = ~Sales, type = "bar")

  })

}
  # Create Shiny app ----
  shinyApp(ui, server)

【问题讨论】：

标签： r shiny dplyr

【解决方案1】：

您可以从{shinyWidgets} 使用pickerInput。

我运行了您的代码，并进行了以下调整：

pickerInput("services",
            "Select services:",
            choices = unique(data$Services),
            multiple = TRUE,
            selected = NULL,
            options = list(
                  title = "Services",
                  #"max-options" = 1,
                  `actions-box` = TRUE,
                  `deselect-all-text` = "Remove"
                ))

pickerInput(inputId = "rev",
            label = "Profit/loss",
            choices = unique(ServiceSub()[,"Prof.Los"]),
            selected = unique(ServiceSub()[,"Prof.Los"]),
            multiple = TRUE,
            options = list(
                  title = "Profit/loss",
                  #"max-options" = 1,
                  `actions-box` = TRUE,
                  `deselect-all-text` = "Remove"
                ))

【讨论】：