R 相互依赖的闪亮输入与2个输入崩溃
在我下面的示例中，R 相互依赖的闪亮输入与2个输入崩溃,r,shiny,R,Shiny,在我下面的示例中，selectInputs在我将它们一起选择之前一直运行良好。 我希望输入是相互依赖的。在级联输入中，一切工作正常！ 我认为，问题可能与条件变量有关 谢谢你的帮助 数据是关于大陆和国家的，如果你选择一个大陆，你将能够看到这个大陆上的所有国家。但当我点击某个特定国家时，应用程序似乎会重置 df <- structure(list(Continent = c("Asia", "Oceania", "Europe", "North America", "Europe
selectInputsdf <- 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)
df您的问题是，每当您更新输入字段时，输入都被设置为NULL
我通过使renderUI
语句保持静态（只运行一次）解决了您的问题。如果这不可能，您也可以将其放在隔离
语句中。我添加了两个observe来更新选项。在这里，我还使用了一个小技巧设置selected=input$constratine
这将保持当前选择并解决您的问题
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))
})
})
server=shinyServer（功能（输入、输出、会话）{
数据你认为有可能做一些更聪明的事情，而不是我在代码中为反应式df
所做的所有条件吗？@Mostafa确定你实际上只需要两个，如果-我在回答中简化了你的代码谢谢，它非常干净！没有出现多个选项是正常的吗？