如何使用 R shiny 中的 updateSelectizeInput() 在图形中创建“全选”选项？

Question

我正在开发一个 Shiny 应用程序，用户将能够 select 下拉列表中的所有选项、选项子集和/或单个选项。

我要使用的可重现数据示例：

set.seed(42)
n <- 366

mydata <- data.frame(id=1:n,
                     date = seq.Date(as.Date("2020-01-01"), as.Date("2020-12-31"), "day"),
                     group = rep(LETTERS[1:26], n/2))

#write_csv(mydata, "repex.csv")

我的 R Shiny 代码：

library(shiny)
library(tidyverse)
library(plotly)


mydata <- read_csv("repex.csv")

choices <- c('Select All', 'apple' = 'A', 'beta' = 'B', 'croc' = 'C', 'delta' = 'D',
             'echo chamber' = 'E', 'fudge nuggets' = 'F', 'good boy' = 'G', 'hot' = 'H',
             'it-tree' = 'I', 'joker' = 'J', 'kale' = 'K', 'lambo' = 'L', 'merry' = 'M', 
             'not so easy' = 'N', 'open' = 'O', 'pickles' = 'P', 'quasi' = 'Q', 'rotary' = 'R',
             'same' = 'S', 'token' = 'T', 'unix' = 'U', 'virtue' = 'V', 'whack-a-mole' = 'W', 
             'xylaphone?' = 'X', 'yeti' = 'Y', 'zebra' = 'Z')

#ui
ui <- fluidPage(
  titlePanel("My Dashboard"),
  sidebarLayout(
    sidebarPanel(
      dateRangeInput("dateRange", "Select date range:"),
      selectizeInput('group_type', 'For no action cases, select reason:', 
                     choices = choices, multiple = TRUE)
    ),
    mainPanel(
      tabsetPanel(
        tabPanel('plot1',
                 plotlyOutput("plot1")),
        tabPanel('plot2',
                 plotlyOutput('plot2')),
        tabPanel('plot3',
                 plotlyOutput('plot_3'))
        
      )
    )
  )
)



server <- function(input, output, clientData, session) {
  
  mydata <- mydata %>%
    mutate(
      date = as.Date(date, format="%Y-%m-%d")) %>%
    select(id, date, group)
  
  
  thedata <- reactive({
    my_data <- mydata
    # And update the date range values to match those of the dataset
    updateDateRangeInput(
      inputId = "dateRange",
      session = session,
      start = min(my_data$date),
      end = max(my_data$date)
    )
    my_data
  })
  
  
  observe({
    if ("Select All" %in% input$group_type) {
      selected_choices <- setdiff(choices, "Select All")
      
      updateSelectizeInput(session, "group_type", selected = selected_choices,
                           server = TRUE)
    }
  })
  
  
  output$plot_3 <- renderPlotly({
    # I need to subset the data, using the user input (dateRangeInput)
    data_subset3 <- dplyr::filter(thedata(),
                                  date >= input$dateRange[[1]],
                                  date <= input$dateRange[[2]])
    
    
    # And plot the subset of data
    data_subset3 %>%
      filter(group == input$group_type) %>%
      group_by(date, group) %>%
      summarise(counts = n()) %>%
      ungroup() %>%
      ggplot(., aes(date, counts, color = group)) +
      geom_point() +
      theme_bw()
    
  })
  
  
}

shinyApp(ui = ui, server = server)

The current issue I'm having is when I go to plot 3, select the date range, and then select the 'Select All' option the graph stops working and I have to refresh the page. 我希望用户能够 select 一次显示所有组（按组着色），一次显示组的子集（例如“apple”、“beta”和“yeti”），或者只是一组展示。

所有组都具有相同的分布，因此对于我的 repex 数据，这可能看起来没有用，但对于我的实际数据，这将是很棒的事情！

谢谢！

Answer 1

我认为您想使用%in%而不是== 。

data_subset3 %>%
  filter(group %in% input$group_type) %>%
  group_by(date, group) %>%
  summarise(counts = n()) %>%
  ungroup() %>%
  ggplot(., aes(date, counts, color = group)) +
  geom_point() +
  theme_bw()

Answer 2

我找到了一个很好的解决方案。 我还包括一个清除所有选择的选项：

library(shiny)
library(tidyverse)
library(plotly)


mydata <- read_csv("repex.csv")

choices <- c('Select All', 'apple' = 'A', 'beta' = 'B', 'croc' = 'C', 'delta' = 'D',
             'echo chamber' = 'E', 'fudge nuggets' = 'F', 'good boy' = 'G', 'hot' = 'H',
             'it-tree' = 'I', 'joker' = 'J', 'kale' = 'K', 'lambo' = 'L', 'merry' = 'M', 
             'not so easy' = 'N', 'open' = 'O', 'pickles' = 'P', 'quasi' = 'Q', 'rotary' = 'R',
             'same' = 'S', 'token' = 'T', 'unix' = 'U', 'virtue' = 'V', 'whack-a-mole' = 'W', 
             'xylaphone?' = 'X', 'yeti' = 'Y', 'zebra' = 'Z')

#ui
ui <- fluidPage(
  titlePanel("My Dashboard"),
  sidebarLayout(
    sidebarPanel(
      dateRangeInput("dateRange", "Select date range:"),
      selectInput('group_type', 'For no action cases, select reason:', 
                     choices = choices, multiple = TRUE),
      actionButton('reset_group', 'Clear selection(s)')
    ),
    mainPanel(
      tabsetPanel(
        tabPanel('plot1',
                 plotlyOutput("plot1")),
        tabPanel('plot2',
                 plotlyOutput('plot2')),
        tabPanel('plot3',
                 plotlyOutput('plot_3'))
        
      )
    )
  )
)



server <- function(input, output, clientData, session) {
  
  mydata <- mydata %>%
    mutate(
      date = as.Date(date, format="%Y-%m-%d")) %>%
    select(id, date, group)
  
  
  thedata <- reactive({
    my_data <- mydata
    # And update the date range values to match those of the dataset
    updateDateRangeInput(
      inputId = "dateRange",
      session = session,
      start = min(my_data$date),
      end = max(my_data$date)
    )
    my_data
  })
  
  
  observe({
    if ("Select All" %in% input$group_type) 
      selected_choices <- choices[-1]
    else
      selected_choices <- input$group_type
    updateSelectInput(session, "group_type", selected = selected_choices)
    
  })
  
  
  observeEvent(input$reset_group, {
    updateSelectInput(session, "group_type", selected = "")
  })
  
  
  output$plot_3 <- renderPlotly({
    # I need to subset the data, using the user input (dateRangeInput)
    data_subset3 <- dplyr::filter(thedata(),
                                  date >= input$dateRange[[1]],
                                  date <= input$dateRange[[2]])
    
    
    # And plot the subset of data
    data_subset3 %>%
      filter(group %in% input$group_type) %>%
      group_by(date, group) %>%
      summarise(counts = n()) %>%
      ungroup() %>%
      ggplot(., aes(date, counts, color = group, group = group)) +
      geom_line() +
      theme_bw()
    
  })
  
  
}

shinyApp(ui = ui, server = server)

我已经从geom_point()更改为geom_line()以查看这是否仍然适用于其他图形类型。

Answer 3

您需要正确进行子集化，并且不需要updateSelectizeInput 。 尝试这个

set.seed(42)
n <- 366

mydata <- data.frame(id=1:n,
                     date = seq.Date(as.Date("2020-01-01"), as.Date("2020-12-31"), "day"),
                     group = rep(LETTERS[1:26], n/2))

library(shiny)
library(tidyverse)
library(plotly)

#mydata <- read_csv("repex.csv")

choices <- c('Select All', 'apple' = 'A', 'beta' = 'B', 'croc' = 'C', 'delta' = 'D',
             'echo chamber' = 'E', 'fudge nuggets' = 'F', 'good boy' = 'G', 'hot' = 'H',
             'it-tree' = 'I', 'joker' = 'J', 'kale' = 'K', 'lambo' = 'L', 'merry' = 'M', 
             'not so easy' = 'N', 'open' = 'O', 'pickles' = 'P', 'quasi' = 'Q', 'rotary' = 'R',
             'same' = 'S', 'token' = 'T', 'unix' = 'U', 'virtue' = 'V', 'whack-a-mole' = 'W', 
             'xylaphone?' = 'X', 'yeti' = 'Y', 'zebra' = 'Z')

#ui
ui <- fluidPage(
  titlePanel("My Dashboard"),
  sidebarLayout(
    sidebarPanel(
      dateRangeInput("dateRange", "Select date range:"),
      selectizeInput('group_type', 'For no action cases, select reason:', 
                     choices = choices, multiple = TRUE)
    ),
    mainPanel(
      tabsetPanel(
        tabPanel('plot1',
                 plotOutput("plot1")),
        tabPanel('plot2',
                 plotOutput('plot2')),
        tabPanel('plot3', DTOutput("t1"),
                 plotlyOutput('plot_3'))
        
      )
    )
  )
)

server <- function(input, output, clientData, session) {
  
  mydata <- mydata %>%
    mutate(date = as.Date(date, format="%Y-%m-%d")) %>%
      dplyr::select(id, date, group)
  
  ### I need to subset the data, using the user input (dateRangeInput)
  data_subset1 <- eventReactive(input$dateRange, {
    dplyr::filter(mydata,
                  date >= input$dateRange[[1]],
                  date <= input$dateRange[[2]]) 
  })
  
  data_subset3 <- eventReactive(c(data_subset1(),input$group_type), {
    req(data_subset1(),input$group_type)
    if ("Select All" %in% input$group_type) dfa <- data_subset1()
    else dfa <- data_subset1() %>% dplyr::filter(group %in% input$group_type)
    df <- dfa %>%
      group_by(date,group) %>%
      dplyr::summarise(counts = n()) %>%
      ungroup() 
    df
  })
  
  output$t1 <- renderDT({data_subset1()})
  
  observe({
    my_data <- mydata
    # And update the date range values to match those of the dataset
    updateDateRangeInput(
      inputId = "dateRange",
      session = session,
      start = min(my_data$date),
      end = max(my_data$date)
    )

    # if ("Select All" %in% input$group_type) {
    #   selected_choices <- setdiff(choices, "Select All")
    #
    #   updateSelectizeInput(session, "group_type", selected = selected_choices,
    #                        server = TRUE)
    # }
  })
  
  
  
  output$plot1 <- renderPlot({plot(cars)})
  output$plot2 <- renderPlot({plot(pressure)})
  output$plot_3 <- renderPlotly({
    req(data_subset3())
    p <- ggplot(data_subset3(), aes(date, counts, color = group)) +
      geom_point() +
      theme_bw()
    ggplotly(p)
  })
  
}

shinyApp(ui = ui, server = server)