问题描述
我有三个selectInputs，我希望第一个（大陆）中的选择更改第二个（国家）和第三个（州）中的可能选择。因此，例如，如果有人在第一个输入框中选择“ B”，则只能在第二个框中选择“ A”，在最后一个框中选择“ BB”。
目前，可以为状态框选择所有名称。
代码：
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)
解决方法
也许这就是您要寻找的。我认为您的方法过于复杂。因此，我大大减少了代码。现在，除了输出外，服务器中基本上还包含三个部分：
- 用于过滤数据集的反应式
- 三个反应堆以获取所选值
- 三个反应堆可根据其他输入获得可用的选择。国家/地区的可用选项是按洲过滤后的国家列表，国家/地区的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,Country %in% country()) %>%
pull(State) %>%
unique()
})
output$table_subset <- DT::renderDataTable({
DT::datatable(data_filtered(),options = list(scrollX = T))
})
})
shinyApp(ui,server)