基于 R 中另一个 selectInput 的选择的 SelectInput 过滤器

Question

我有三个 select 输入，我希望第一个（大陆）中的 selection 改变第二个（国家/地区）中可能的 selection第三个（州）。因此，例如，如果某人在第一个输入框中选择“B”，则只能在第二个输入框中选择“A”，在最后一个输入框中选择“BB”。

并且目前可以select框状态的所有名称。

代码：

library(shiny)
library(readxl)
library(shinydashboard)
library(dplyr)
library(DT)

df <-  data.frame(Continent = c("A","A","B","C"),
                    Country = rep("A",4),
                    State = c("AA","AA","BB","BB"),
                    Population = round(rnorm(4,100,2)),stringsAsFactors = FALSE)

is.not.null <- function(x) !is.null(x)

ui <- fluidPage(
  
  titlePanel("TEST"),
  sidebarLayout(
    sidebarPanel( width = 3,
                  uiOutput("continent"),
                  uiOutput("country"),
                  uiOutput("state")
                  
    ),
    mainPanel(
        tabsetPanel(type = "tabs",
                  tabPanel("Table", DT::dataTableOutput("table_subset"))
      )
      
    )
  )
)

ui = dashboardPage(
  header,
  sidebar,
  body
)

################################################

server = shinyServer(function(input,output){
  
  data <- df
  
  output$table <- DT::renderDataTable({
    if(is.null(data)){return()}
    DT::datatable(data, options = list(scrollX = T))
  })
  
  output$continent <- renderUI({
    selectInput(inputId = "Continent", "Select Continent",choices = var_continent(), multiple = F)
  })
  output$country <- renderUI({
    selectInput(inputId = "Country", "Select Country",choices = var_country(), multiple = T)
  })
  output$state <- renderUI({
    selectInput(inputId = "State", "Select State",choices = var_state(), multiple = T)
  })
  
  var_continent <- reactive({
    file1 <- data
    if(is.null(data)){return()}
    as.list(unique(file1$Continent))
  })
  
  continent_function <- reactive({
    file1 <- data
    continent <- input$Continent
    continent <<- input$Continent
    if (is.null(continent)){
      return(file1)
    } else {
      file2 <- file1 %>%
        filter(Continent %in% continent)
      return (file2)
    }
    
  })
  
  var_country <- reactive({
    file1 <- continent_function()
    continent <- input$Continent
    file2 <- data
    
    if(is.null(continent)){
      as.list(unique(file2$Country))
    } else {
      as.list(unique(file1$Country))
    }
  })
  
  country_function <- reactive({
    file1 <- data
    country <- input$Country
    country <<- input$Country
    if (is.null(country)){
      return(file1)
    } else {
      file2 <- file1 %>%
        filter(Country %in% country)
      return (file2)
    }
    
  })
  
  var_state <- reactive({
    file1 <- country_function()
    country <- input$Country
    file2 <- data
    
    if(is.null(country)){
      as.list(unique(file2$State))
    } else {
      as.list(unique(file1$State))
    }
  })
  
  state_function <- reactive({
    file1 <- data
    state <- input$State
    state <<- input$State
    if (is.null(state)){
      return(file1)
    } else {
      file2 <- file1 %>%
        filter(State %in% state)
      return (file2)
    }
    
  })
  
  df <- reactive({
    
    file1 <- data
    continent <- input$Continent
    country <- input$Country
    state <- input$State
    
    if (is.null(continent) & is.not.null(country) & is.not.null(state)){
      file2 <- file1 %>%
        filter(Country %in% country, State %in% state)
    } else if (is.null(country) & is.not.null(continent) & is.not.null(state)){
      file2 <- file1 %>%
        filter(State %in% state, Continent %in% continent)
    } else if (is.null(state) & is.not.null(country) & is.not.null(continent)){
      file2 <- file1 %>%
        filter(Country %in% country, Continent %in% continent)
    } else if (is.null(continent) & is.null(country) & is.not.null(state)){
      file2 <- file1 %>%
        filter(State %in% state)
    } else if (is.null(continent) & is.null(state) & is.not.null(country)){
      file2 <- file1 %>%
        filter(Country %in% country)
    } else if (is.null(country) & is.null(state) & is.not.null(continent)){
      file2 <- file1 %>%
        filter(Continent %in% continent)
    } else {
      file2 <- file1 %>%
        filter(Country %in% country, State %in% state, Continent %in% continent)
    }
    file2
  })
  
  output$table_subset <- DT::renderDataTable({
    DT::datatable(df(), options = list(scrollX = T))
    
  })
  
})

shinyApp(ui, server)

Answer 1

也许这就是您要找的。我认为您的方法过于复杂。因此我大大减少了代码。除了输出之外，服务器现在基本上分为三个部分：

过滤数据集的反应式
获得所选值的三个反应
根据其他输入获得可用选择的三个反应。 Country 的可用选项是按大陆过滤后的国家列表，States 的 avialbel 选择是按大陆和国家/地区过滤后的州列表

可重现代码：

library(shiny)
library(shinydashboard)
library(dplyr)
library(DT)

df <-  data.frame(Continent = c("A","A","B","C"),
                  Country = rep("A",4),
                  State = c("AA","AA","BB","BB"),
                  Population = round(rnorm(4,100,2)),stringsAsFactors = FALSE)

is.not.null <- function(x) !is.null(x)

ui <- fluidPage(
  
  titlePanel("TEST"),
  sidebarLayout(
    sidebarPanel( width = 3,
                  uiOutput("continent"),
                  uiOutput("country"),
                  uiOutput("state")
                  
    ),
    mainPanel(
      tabsetPanel(type = "tabs",
                  tabPanel("Table", DT::dataTableOutput("table_subset"))
      )
      
    )
  )
)

# ui = dashboardPage(
#   header,
#   sidebar,
#   body
# )

################################################

server = shinyServer(function(input,output){
  
  data <- df
  
  output$table <- DT::renderDataTable({
    if(is.null(data)){return()}
    DT::datatable(data, options = list(scrollX = T))
  })
  
  output$continent <- renderUI({
    selectInput(inputId = "Continent", "Select Continent",choices = var_continent(), multiple = F)
  })
  output$country <- renderUI({
    selectInput(inputId = "Country", "Select Country",choices = var_country(), multiple = T)
  })
  output$state <- renderUI({
    selectInput(inputId = "State", "Select State",choices = var_state(), multiple = T)
  })
    
  # Filtered data
  data_filtered <- reactive({
    filter(df, Continent %in% continent(), Country %in% country(), State %in% state())
  })
  
  # Get filters from inputs
  continent <- reactive({
    if (is.null(input$Continent)) unique(df$Continent) else input$Continent
  })
  
  country <- reactive({
    if (is.null(input$Country)) unique(df$Country) else input$Country
  })
  
  state <- reactive({
    if (is.null(input$State)) unique(df$State) else input$State
  })
  
  # Get available categories
  var_continent <- reactive({
    file1 <- data
    if(is.null(data)){return()}
    as.list(unique(file1$Continent))
  })
  
  var_country <- reactive({
    filter(data, Continent %in% continent()) %>% 
      pull(Country) %>% 
      unique()
  })
  
  var_state <- reactive({
    filter(data, Continent %in% continent(), Country %in% country()) %>% 
      pull(State) %>% 
      unique()
  })

  output$table_subset <- DT::renderDataTable({
    DT::datatable(data_filtered(), options = list(scrollX = T))
  })
  
})

shinyApp(ui, server)

基于 R 中另一个 selectInput 的选择的 SelectInput 过滤器

SelectInput filter based on a selection from another selectInput in R

r

filter

shiny

shiny-server

shiny-reactivity