在具有多个交互的 Shiny dynamic UI 的算法中需要帮助
Need help in an algorithm for Shiny dynamic UI with multiple interactions
我的闪亮算法(app.R 代码在底部):
- 要求用户上传文件
- 提供带有选项 "None"、"Country"、"State"、"City"
的下拉字段
- 当 "None" 被 selected 时,只应出现文本输出
- 当 "Country" 被 selected 时,应该只出现国家/地区过滤器
- 当 "State" 被 selected 时,国家和州过滤器都应该出现
- 当 "City" 被 selected 时,国家和城市过滤器都应该出现,之前 selections 的任何现有状态过滤器都应该消失
我在代码中做了什么:
"None" 和 "Country" 使用 IF 条件; "State" 和 "City".
使用 Switch
我的问题:
一切都按预期工作,除了一个:如果我们 select "State" 在 selecting "None" 之后,我看到 textOutput 和 State 过滤器而不是国家和状态过滤器。发生这种情况是因为 "None" 或 "Country" 中的 IF 语句与 switch() 不同,它只打印 UI 而不会清除 UI 如果另一个 select离子制成
我的约束:
需要在代码中复制国家过滤器输入("State"
应该同时提供国家和州过滤器,类似于 "City") 但是
我们不能在闪亮的代码中复制具有相同 ID 的输入
我不能使用不同的国家过滤器 ID 来提供相同的输入
因为我需要读入国家/地区过滤器中的输入值
多个地方,我需要复制所有这些和那个
会使一切复杂化
我需要帮助的地方:
我这里唯一的问题是,如果用户 selects ("State"/"City") 在 "None" 之后(绕过 "Country"!!!)。
真的需要修好这个东西。任何帮助将不胜感激
谢谢!
虚拟数据:https://docs.google.com/spreadsheets/d/1E9dbtOMm1-7ZjIHu3Ra_NyFBHrCQdITG2_xuMIMKDOs/edit?usp=sharing
app.R代码
library(shiny)
ui <- fluidPage(
fileInput("file_attr", "Door attributes:"),
selectInput("select", label = "Region Drop down", choices = list("None", "Country", "State","City"), selected = "None"),
uiOutput("NoneCountryFilter"),
uiOutput("StateCityFilter")
)
server <- function(input, output, session) {
#Reading input
data_attr <- reactive({
file1 <- input$file_attr
if(is.null(file1)){return()}
read.table(file=file1$datapath, sep=",", header = TRUE, stringsAsFactors = FALSE)
})
#Filter interactivity
#Reading Lists
countries <- reactive({
if(is.null(data_attr()$Country)){return()}
data_attr()$Country
})
states <- reactive({
if(is.null(data_attr()$State)){return()}
data_attr()$State[data_attr()$Country %in% input$show_vars]
})
cities <- reactive({
if(is.null(data_attr()$City)){return()}
data_attr()$City[data_attr()$Country %in% input$show_vars]
})
#Filters based on Region Drop down
observeEvent(input$file_attr,{
observe({
if ("None" %in% input$select){
output$NoneCountryFilter <- renderUI({
if(is.null(data_attr()$Country)){return()}
h4("No region Selected")
})
}
if ("Country" %in% input$select){
output$NoneCountryFilter <- renderUI({
if(is.null(data_attr()$Country)){return()}
selectizeInput('show_vars', 'Country Filter', choices = c("Select All","None", unique(countries())), multiple = TRUE)
})
}
})
output$StateCityFilter <- renderUI({
switch(input$select,
"State" = (
selectizeInput('show_vars_state', 'State Filter', choices = c("Select All","None", unique(states())), multiple = TRUE)
),
"City" = (
selectizeInput('show_vars_city', 'City Filter', choices = c("Select All","None", unique(cities())), multiple = TRUE)
)
)
})
})
#Giving "Select ALL" and "None" Functionality to each filter (This part is redundant for the current problem. I am keeping this so that I could check any solution from Whosebug should not effect other functionalities)
#Countries- SelectAll & None
observe({
if ("Select All" %in% input$show_vars){
selected_choices <- setdiff(c("Select All",unique(countries())), "Select All")
updateSelectizeInput(session, 'show_vars', choices = c("Select All","None",unique(countries())), selected = selected_choices)
}
})
observe({
if ("None" %in% input$show_vars){
updateSelectizeInput(session, 'show_vars', choices = c("Select All", "None", unique(countries())),selected = "")
}
})
#State- SelectAll & None
observe({
if ("Select All" %in% input$show_vars_state){
selected_choices <- setdiff(c("Select All",unique(states())), "Select All")
updateSelectizeInput(session, 'show_vars_state', choices = c("Select All","None",unique(states())), selected = selected_choices)
}
})
observe({
if ("None" %in% input$show_vars_state){
updateSelectizeInput(session, 'show_vars_state', choices = c("Select All", "None", unique(states())),selected = "")
}
})
#City- SelectAll & None
observe({
if ("Select All" %in% input$show_vars_city){
selected_choices <- setdiff(c("Select All",unique(cities())), "Select All")
updateSelectizeInput(session, 'show_vars_city', choices = c("Select All", "None", unique(cities())), selected = selected_choices)
}
})
observe({
if ("None" %in% input$show_vars_city){
updateSelectizeInput(session, 'show_vars_city', choices = c("Select All", "None", unique(cities())),selected = "")
}
})
}
shinyApp(ui = ui, server = server)
您可以使用 conditionalPanel
来确定根据特定条件显示哪些元素。
备注:
我在 data_attr
中使用了 req()
,因为这是对 file_attr
的检查。您不必使用 is.null()
.
我用了三个conditionalPanel
代表Country, State, City,并为每个指定了条件。
条件里面,input.select
不是input$select
。
library(shiny)
ui <- fluidPage(
fileInput("file_attr", "Door attributes:"),
selectInput("select", label = "Region Drop down",
choices = list("None", "Country", "State","City"), selected = "None"),
# Selectize Inputs ---------------
uiOutput("Country_List"),
uiOutput("State_List"),
uiOutput("City_List")
)
server <- function(input, output, session) {
#Reading input
data_attr <- reactive({
req(input$file_attr) # make sure a file was uploaded
read.table(file=input$file_attr$datapath, sep=",", header = TRUE, stringsAsFactors = FALSE)
})
# Country selectizeInput ----------------------
output$Country_List <- renderUI({
conditionalPanel(
condition = "input.select == 'Country' | input.select == 'State'| input.select == 'City' ",
selectizeInput('show_var', 'Country Filter',
choices = c("Select All","None", unique(data_attr()$Country)), multiple = TRUE)
)
})
# State selectizeInput ----------------------
output$State_List <- renderUI({
conditionalPanel(
condition = "input.select == 'State' ",
selectizeInput('show_vars_state', 'State Filter',
choices = c("Select All","None", unique(data_attr()$State)), multiple = TRUE)
)
})
# City selectizeInput -----------------------
output$City_List <- renderUI({
conditionalPanel(
condition = "input.select == 'City' ",
selectizeInput('show_vars_city', 'City Filter',
choices = c("Select All","None", unique(data_attr()$City)), multiple = TRUE)
)
})
}
shinyApp(ui = ui, server = server)
我的闪亮算法(app.R 代码在底部):
- 要求用户上传文件
- 提供带有选项 "None"、"Country"、"State"、"City" 的下拉字段
- 当 "None" 被 selected 时,只应出现文本输出
- 当 "Country" 被 selected 时,应该只出现国家/地区过滤器
- 当 "State" 被 selected 时,国家和州过滤器都应该出现
- 当 "City" 被 selected 时,国家和城市过滤器都应该出现,之前 selections 的任何现有状态过滤器都应该消失
我在代码中做了什么: "None" 和 "Country" 使用 IF 条件; "State" 和 "City".
使用 Switch我的问题: 一切都按预期工作,除了一个:如果我们 select "State" 在 selecting "None" 之后,我看到 textOutput 和 State 过滤器而不是国家和状态过滤器。发生这种情况是因为 "None" 或 "Country" 中的 IF 语句与 switch() 不同,它只打印 UI 而不会清除 UI 如果另一个 select离子制成
我的约束:
需要在代码中复制国家过滤器输入("State" 应该同时提供国家和州过滤器,类似于 "City") 但是 我们不能在闪亮的代码中复制具有相同 ID 的输入
我不能使用不同的国家过滤器 ID 来提供相同的输入 因为我需要读入国家/地区过滤器中的输入值 多个地方,我需要复制所有这些和那个 会使一切复杂化
我需要帮助的地方: 我这里唯一的问题是,如果用户 selects ("State"/"City") 在 "None" 之后(绕过 "Country"!!!)。
真的需要修好这个东西。任何帮助将不胜感激
谢谢!
虚拟数据:https://docs.google.com/spreadsheets/d/1E9dbtOMm1-7ZjIHu3Ra_NyFBHrCQdITG2_xuMIMKDOs/edit?usp=sharing
app.R代码
library(shiny)
ui <- fluidPage(
fileInput("file_attr", "Door attributes:"),
selectInput("select", label = "Region Drop down", choices = list("None", "Country", "State","City"), selected = "None"),
uiOutput("NoneCountryFilter"),
uiOutput("StateCityFilter")
)
server <- function(input, output, session) {
#Reading input
data_attr <- reactive({
file1 <- input$file_attr
if(is.null(file1)){return()}
read.table(file=file1$datapath, sep=",", header = TRUE, stringsAsFactors = FALSE)
})
#Filter interactivity
#Reading Lists
countries <- reactive({
if(is.null(data_attr()$Country)){return()}
data_attr()$Country
})
states <- reactive({
if(is.null(data_attr()$State)){return()}
data_attr()$State[data_attr()$Country %in% input$show_vars]
})
cities <- reactive({
if(is.null(data_attr()$City)){return()}
data_attr()$City[data_attr()$Country %in% input$show_vars]
})
#Filters based on Region Drop down
observeEvent(input$file_attr,{
observe({
if ("None" %in% input$select){
output$NoneCountryFilter <- renderUI({
if(is.null(data_attr()$Country)){return()}
h4("No region Selected")
})
}
if ("Country" %in% input$select){
output$NoneCountryFilter <- renderUI({
if(is.null(data_attr()$Country)){return()}
selectizeInput('show_vars', 'Country Filter', choices = c("Select All","None", unique(countries())), multiple = TRUE)
})
}
})
output$StateCityFilter <- renderUI({
switch(input$select,
"State" = (
selectizeInput('show_vars_state', 'State Filter', choices = c("Select All","None", unique(states())), multiple = TRUE)
),
"City" = (
selectizeInput('show_vars_city', 'City Filter', choices = c("Select All","None", unique(cities())), multiple = TRUE)
)
)
})
})
#Giving "Select ALL" and "None" Functionality to each filter (This part is redundant for the current problem. I am keeping this so that I could check any solution from Whosebug should not effect other functionalities)
#Countries- SelectAll & None
observe({
if ("Select All" %in% input$show_vars){
selected_choices <- setdiff(c("Select All",unique(countries())), "Select All")
updateSelectizeInput(session, 'show_vars', choices = c("Select All","None",unique(countries())), selected = selected_choices)
}
})
observe({
if ("None" %in% input$show_vars){
updateSelectizeInput(session, 'show_vars', choices = c("Select All", "None", unique(countries())),selected = "")
}
})
#State- SelectAll & None
observe({
if ("Select All" %in% input$show_vars_state){
selected_choices <- setdiff(c("Select All",unique(states())), "Select All")
updateSelectizeInput(session, 'show_vars_state', choices = c("Select All","None",unique(states())), selected = selected_choices)
}
})
observe({
if ("None" %in% input$show_vars_state){
updateSelectizeInput(session, 'show_vars_state', choices = c("Select All", "None", unique(states())),selected = "")
}
})
#City- SelectAll & None
observe({
if ("Select All" %in% input$show_vars_city){
selected_choices <- setdiff(c("Select All",unique(cities())), "Select All")
updateSelectizeInput(session, 'show_vars_city', choices = c("Select All", "None", unique(cities())), selected = selected_choices)
}
})
observe({
if ("None" %in% input$show_vars_city){
updateSelectizeInput(session, 'show_vars_city', choices = c("Select All", "None", unique(cities())),selected = "")
}
})
}
shinyApp(ui = ui, server = server)
您可以使用 conditionalPanel
来确定根据特定条件显示哪些元素。
备注:
我在
data_attr
中使用了req()
,因为这是对file_attr
的检查。您不必使用is.null()
.我用了三个
conditionalPanel
代表Country, State, City,并为每个指定了条件。条件里面,
input.select
不是input$select
。
library(shiny)
ui <- fluidPage(
fileInput("file_attr", "Door attributes:"),
selectInput("select", label = "Region Drop down",
choices = list("None", "Country", "State","City"), selected = "None"),
# Selectize Inputs ---------------
uiOutput("Country_List"),
uiOutput("State_List"),
uiOutput("City_List")
)
server <- function(input, output, session) {
#Reading input
data_attr <- reactive({
req(input$file_attr) # make sure a file was uploaded
read.table(file=input$file_attr$datapath, sep=",", header = TRUE, stringsAsFactors = FALSE)
})
# Country selectizeInput ----------------------
output$Country_List <- renderUI({
conditionalPanel(
condition = "input.select == 'Country' | input.select == 'State'| input.select == 'City' ",
selectizeInput('show_var', 'Country Filter',
choices = c("Select All","None", unique(data_attr()$Country)), multiple = TRUE)
)
})
# State selectizeInput ----------------------
output$State_List <- renderUI({
conditionalPanel(
condition = "input.select == 'State' ",
selectizeInput('show_vars_state', 'State Filter',
choices = c("Select All","None", unique(data_attr()$State)), multiple = TRUE)
)
})
# City selectizeInput -----------------------
output$City_List <- renderUI({
conditionalPanel(
condition = "input.select == 'City' ",
selectizeInput('show_vars_city', 'City Filter',
choices = c("Select All","None", unique(data_attr()$City)), multiple = TRUE)
)
})
}
shinyApp(ui = ui, server = server)