能够选择闪亮输入中的所有潜在选项以及动态表
Posted
技术标签:
【中文标题】能够选择闪亮输入中的所有潜在选项以及动态表【英文标题】:The ability to select ALL potential options in a Shiny input along with a dynamic table 【发布时间】:2021-12-27 21:27:48 【问题描述】:下面的代码允许选择三个不同的“阶段”,每个输入依赖于之前的一个。现在代码是这样的:
ui <- fluidPage(
titlePanel("Test Dashboard "),
sidebarLayout(
sidebarPanel(
uiOutput("data1"), ## uiOutput - gets the UI from the server
uiOutput("data2"),
uiOutput("data3")
),
mainPanel()
))
server <- function(input, output)
State <- c("NV", "NV","NV", "MD", "MD", "MD", "MD", "NY", "NY", "NY", "OH", "OH", "OH")
County <- c("CLARK", "WASHOE", "EUREKA", "MONTGOMERY", "HOWARD", "BALTIMORE", "FREDERICK", "BRONX", "QUEENS", "WESTCHESTER", "FRANKLIN", "SUMMIT", "STARK" )
City <- c("Las Vegas", "Reno", "Eureka", "Rockville", "Columbia", "Baltimore", "Thurmont", "Bronx", "Queens", "Yonkers", "Columbus", "Akron", "Canton")
Rating<- c(1,2,3,4,5,6,7,8,9,10,11,12,13)
df <- data.frame(State, County, City, Rating, stringsAsFactors = F)
## renderUI - renders a UI element on the server
## used when the UI element is dynamic/dependant on data
output$data1 <- renderUI(
selectInput("data1", "Select State", choices = c(df$State))
)
## input dependant on the choices in `data1`
output$data2 <- renderUI(
selectInput("data2", "Select County", choices = c(df$County[df$State == input$data1]))
)
output$data3 <- renderUI(
selectInput("data3", "select City", choices = c(df$City[df$County == input$data2]))
)
shinyApp(ui, server)
您会注意到示例数据位于server
侧代码中,并绑定在一起形成df
。
但是,如果我不想缩小每个选项的选择范围怎么办?相反,假设我想遵循以下选择路径:State = "MD"、County = ALL 和 City = ALL。虽然我可以选择仅选择一个或多个选择,但它还包括选择 ALL 的选择。
此外,我还想包括一个可见的动态表,并根据所选值进行自我调整。因此,如果我遵循与上面列出的相同的选择路径,它将返回 State = "MD" 下提交的任何内容的所有附属结果。
每当我尝试添加类似的东西时
DTOutput('table')
在 UI 端和服务器端:
output$table <- renderDT(df,
options = list(
pageLength = 5
)
)
它只是弄乱了整个布局,也没有生成我需要的表格。
【问题讨论】:
【参考方案1】:这里有一些东西可以尝试。您可以使用updateSelectInput
更改您的输入并使其依赖。单独的 reactive
表达式可以根据您的输入过滤您的数据。看看这是否为您提供了预期的行为。
library(shiny)
library(DT)
State <- c("NV", "NV","NV", "MD", "MD", "MD", "MD", "NY", "NY", "NY", "OH", "OH", "OH")
County <- c("CLARK", "WASHOE", "EUREKA", "MONTGOMERY", "HOWARD", "BALTIMORE", "FREDERICK", "BRONX", "QUEENS", "WESTCHESTER", "FRANKLIN", "SUMMIT", "STARK" )
City <- c("Las Vegas", "Reno", "Eureka", "Rockville", "Columbia", "Baltimore", "Thurmont", "Bronx", "Queens", "Yonkers", "Columbus", "Akron", "Canton")
Rating<- c(1,2,3,4,5,6,7,8,9,10,11,12,13)
df <- data.frame(State, County, City, Rating, stringsAsFactors = F)
ui <- fluidPage(
titlePanel("Test Dashboard "),
sidebarLayout(
sidebarPanel(
selectInput("data1", "Select State", choices = c("All", unique(df$State))),
selectInput("data2", "Select County", choices = NULL),
selectInput("data3", "select City", choices = NULL)
),
mainPanel(
DTOutput("table")
)
))
server <- function(input, output, session)
observeEvent(input$data1,
if (input$data1 != "All")
updateSelectInput(session, "data2", "Select County", choices = c("All", unique(df$County[df$State == input$data1])))
else
updateSelectInput(session, "data2", "Select County", choices = c("All", unique(df$County)))
, priority = 2)
observeEvent(c(input$data1, input$data2),
if (input$data2 != "All")
updateSelectInput(session, "data3", "Select City", choices = c("All", unique(df$City[df$County == input$data2])))
else
if (input$data1 != "All")
updateSelectInput(session, "data3", "Select City", choices = c("All", unique(df$City[df$State == input$data1])))
else
updateSelectInput(session, "data3", "Select City", choices = c("All", unique(df$City)))
, priority = 1)
filtered_data <- reactive(
temp_data <- df
if (input$data1 != "All")
temp_data <- temp_data[temp_data$State == input$data1, ]
if (input$data2 != "All")
temp_data <- temp_data[temp_data$County == input$data2, ]
if (input$data3 != "All")
temp_data <- temp_data[temp_data$City == input$data3, ]
temp_data
)
output$table <- renderDT(
filtered_data()
)
shinyApp(ui, server)
【讨论】:
这很有帮助,但priority = ...
的意思是什么?
另外,如果我想添加一个使用 Rating
指标的滑块输入怎么办?
对于priority
,我确保在根据县更新城市之前根据州更新县。以下是有关优先级的更多信息:一个整数或数字,用于控制应执行此观察者的优先级。具有给定优先级的观察者总是比所有具有较低优先级的观察者执行得更快。允许正值、负值和零值。
您可以在其他selectInput
语句之后添加sliderInput
。然后,您还可以根据新的评级输入在reactive
表达式中过滤您的temp_data
。我假设您不想根据评分更改下拉菜单。这有帮助吗?
如果您需要任何其他帮助(例如,使用滑块输入),请告诉我。【参考方案2】:
(也在reddit上回答)
-
这可以通过使用
pickerInput()
包中的shinyWidgets
来实现
library(shinyWidgets)
output$data2 <- renderUI(
pickerInput("data2", "Select County",
choices = c(df$County[df$State == input$data1]),
options = list(`actions-box` = TRUE), multiple = T)
)
-
这可以通过根据用户选择的选项将数据框保存在反应式和过滤中来实现
data <- reactive(
req(input$data1, input$data2, input$data3)
df <- df %>%
filter(State == input$data1) %>%
filter(County %in% input$data2) %>%
filter(City %in% input$data3)
df
)
hole 应用程序如下所示:
library(shiny)
library(shinyWidgets)
library(DT)
ui <- fluidPage(
titlePanel("Test Dashboard "),
sidebarLayout(
sidebarPanel(
uiOutput("data1"), ## uiOutput - gets the UI from the server
uiOutput("data2"),
uiOutput("data3")
),
mainPanel(
DTOutput('table')
)
))
server <- function(input, output, session)
State <- c("NV", "NV","NV", "MD", "MD", "MD", "MD", "NY", "NY", "NY", "OH", "OH", "OH")
County <- c("CLARK", "WASHOE", "EUREKA", "MONTGOMERY", "HOWARD", "BALTIMORE", "FREDERICK", "BRONX", "QUEENS", "WESTCHESTER", "FRANKLIN", "SUMMIT", "STARK" )
City <- c("Las Vegas", "Reno", "Eureka", "Rockville", "Columbia", "Baltimore", "Thurmont", "Bronx", "Queens", "Yonkers", "Columbus", "Akron", "Canton")
Rating<- c(1,2,3,4,5,6,7,8,9,10,11,12,13)
df <- data.frame(State, County, City, Rating, stringsAsFactors = F)
## renderUI - renders a UI element on the server
## used when the UI element is dynamic/dependant on data
output$data1 <- renderUI(
selectInput("data1", "Select State", choices = c(df$State))
)
## input dependant on the choices in `data1`
output$data2 <- renderUI(
pickerInput("data2", "Select County",
choices = c(df$County[df$State == input$data1]),
options = list(`actions-box` = TRUE), multiple = T)
)
output$data3 <- renderUI(
pickerInput("data3", "select City",
choices = c(df$City[df$County %in% input$data2]),
options = list(`actions-box` = TRUE), multiple = T)
)
data <- reactive(
req(input$data1, input$data2, input$data3)
df <- df %>%
filter(State == input$data1) %>%
filter(County %in% input$data2) %>%
filter(City %in% input$data3)
df
)
output$table <- renderDT(
data(), options = list(pageLength = 5)
)
shinyApp(ui, server)
【讨论】:
哇,我喜欢这个!谢谢! 其实我有一个问题。如果我不希望所有输入完全相互依赖怎么办?例如,如果我想让选择县和市相互独立怎么办?虽然它们都取决于所选的州,但假设我想跳过县直接进入城市? 进一步阐述。假设我只想做内华达州 -> 拉斯维加斯,而不必选择县。或者如果我想在不必选择城市的情况下前往内华达州 -> 克拉克?以上是关于能够选择闪亮输入中的所有潜在选项以及动态表的主要内容,如果未能解决你的问题,请参考以下文章