在下面的示例中,selectInputs
可以很好地工作,直到我一起选择它们为止。
我希望输入是相互依赖的。在级联输入中,一切正常!
问题可能与我认为的变量条件有关
感谢帮助!
有关洲和国家/地区的数据,如果您选择一个洲,您将能够看到该洲的所有国家/地区。但是,当我单击特定国家/地区时,该应用似乎已重置
df <- structure(list(Continent = c("Asia", "Oceania", "Europe",
"North America", "Europe", "Oceania", "Europe", "South America",
"North America","Europe"), Country = c("India", "Tonga", "Georgia",
"United States", "Spain", "New Zealand", "Sweden", "Suriname",
"United States","Finland"), State = c("Haryana", "State_Tonga",
"State_Georgia", "Florida", "State_Spain", "State_New Zealand",
"State_Sweden", "State_Suriname", "Idaho", "State_Finland"),
Population = c(25353081, 985883, 860759, 589096, 352490, 363655,
143215, 961911, 579311, 131878)), row.names = c(NA, -10L),
class = c("tbl_df", "tbl", "data.frame"))
library(shiny)
library(shinydashboard)
library(dplyr)
library(DT)
is.not.null <- function(x) !is.null(x)
header <- dashboardHeader(
title = "Test",
dropdownMenu(type = "notifications",
notificationItem(
text = "RAS",
icon("cog", lib = "glyphicon")
)
)
)
sidebar <- dashboardSidebar(
sidebarMenu(
menuItem("Data", tabName = "ShowData", icon = icon("dashboard")),
menuItem("Summary", tabName = "ShowSummary", icon = icon("bar-chart-o"))
)
)
body <- dashboardBody(
tabItems(
tabItem(tabName = "ShowData",
DT::dataTableOutput("table")
),
tabItem(tabName = "ShowSummary",
box(width =3,
h3("Test"),
helpText("Please Continent, Country and State Combition"),
uiOutput("continent"),
uiOutput("country")
),
box(width =9,
DT::dataTableOutput("table_subset")
)
)
)
)
# Put them together into a dashboardPage
ui = dashboardPage(
header,
sidebar,
body
)
################################################
################################################
server = shinyServer(function(input,output){
data <- bind_rows(replicate(500, df, simplify = FALSE))
# Showing the original data
output$table <- DT::renderDataTable({
if(is.null(data)){return()}
DT::datatable(data, options = list(scrollX = T))
})
# Creating filters
output$continent <- renderUI({
selectInput(inputId = "Continent", "Select Continent",choices = c(var_continent()), multiple = T)
})
output$country <- renderUI({
selectInput(inputId = "Country", "Select Country",choices = c(var_country()), multiple = T)
})
# Cascasing filter for state
var_continent <- reactive({
file1 <- data
country <- input$Country
file2 <- country_function()
if(is.null(country)){
as.list(unique(file1$Continent))
} else {
as.list(c(unique(file2$Continent)))
}
})
# Creating reactive function to subset data
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 <- data
continent <- input$Continent
file2 <- continent_function()
if(is.null(continent)){
as.list(unique(file1$Country))
} else {
as.list(unique(file2$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)
}
})
df <- reactive({
file1 <- data
continent <- input$Continent
country <- input$Country
if (is.null(continent) & is.not.null(country)){
file2 <- file1 %>%
filter(Country %in% country)
} else if (is.null(country) & is.not.null(continent)){
file2 <- file1 %>%
filter(Continent %in% continent)
} else if (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)){
file2 <- NULL
} else if (is.null(continent) & is.not.null(country)){
file2 <- file1 %>%
filter(Country %in% country)
} else if (is.null(country) & is.not.null(continent)){
file2 <- file1 %>%
filter(Continent %in% continent)
} else {
file2 <- file1 %>%
filter(Country %in% country, Continent %in% continent)
}
file2
})
output$table_subset <- DT::renderDataTable({
# validate(
# need(input$Continent, 'Check that'),
# need(input$Country, 'Please choose :)')
# need(input$State, 'Please choose :D')
# )
DT::datatable(df(), options = list(scrollX = T))
})
})
############################ CODE ENDS HERE ###########################################
shinyApp(ui, server)
答案 0 :(得分:1)
您的问题是,每当您更新输入字段时,输入都会设置为NULL
。
我通过使renderUI
语句静态(仅运行一次)解决了您的问题。如果这不可能,您也可以将其放在isolate
语句中。我添加了两个观察来更新选择选项。在这里,我还使用了一个小技巧来设置selected = input$Continent
,这可以使当前选择始终解决您的问题。
server = shinyServer(function(input,output,session){
data <- bind_rows(replicate(500, df, simplify = FALSE))
# Showing the original data
output$table <- DT::renderDataTable({
if(is.null(data)){return()}
DT::datatable(data, options = list(scrollX = T))
})
# Creating filters
output$continent <- renderUI({
selectInput(inputId = "Continent", "Select Continent",choices = unique(data$Continent), multiple = T)
})
output$country <- renderUI({
isolate(
selectInput(inputId = "Country", "Select Country",choices = unique(data$Country), multiple = T)
)
})
observe(
updateSelectInput(
session = session,
inputId = "Continent",
choices = var_continent(),
selected = input$Continent
)
)
observe(
updateSelectInput(
session = session,
inputId = "Country",
choices = var_country(),
selected = input$Country
)
)
# Cascasing filter for state
var_continent <- reactive({
file1 <- data
country <- input$Country
file2 <- country_function()
if(is.null(country)){
as.list(unique(file1$Continent))
} else {
as.list(c(unique(file2$Continent)))
}
})
# Creating reactive function to subset data
continent_function <- reactive({
file1 <- data
continent <- input$Continent
if (is.null(continent)){
return(file1)
} else {
file2 <- file1 %>%
filter(Continent %in% continent)
return (file2)
}
})
var_country <- reactive({
file1 <- data
continent <- input$Continent
file2 <- continent_function()
if(is.null(continent)){
as.list(unique(file1$Country))
} else {
as.list(unique(file2$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)
}
})
df <- reactive({
file1 <- data
continent <- input$Continent
country <- input$Country
if (is.not.null(country)){
file1 <- file1 %>%
filter(Country %in% country)
}
if (is.not.null(continent)){
file1 <- file1 %>%
filter(Continent %in% continent)
}
file1
})
output$table_subset <- DT::renderDataTable({
# validate(
# need(input$Continent, 'Check that'),
# need(input$Country, 'Please choose :)')
# need(input$State, 'Please choose :D')
# )
DT::datatable(df(), options = list(scrollX = T))
})
})
希望这会有所帮助