在我正在创建的闪亮应用程序中,我有一组相互连接的下拉列表框。那是一个下拉框的输入决定其他输入的集合。
对于下拉框,我使用selectInput()函数来完成它,还有一些下拉框需要从中选择多个选项。
但是,如果选项数量更多,则用户需要分别选择每个选项。有没有办法一次选择所有选项。
这有点像“ ALL”选项。选择所有内容。
我不想使用"pickerInput"
功能。
由于下拉菜单中的选项取决于先前的下拉菜单输入,因此我无法创建静态选择列表。
作为解决方法,我使用复选框输入来选择下拉列表中的所有值,但不幸的是它不起作用。
请在下面找到UI和服务器代码。
Source_Data <-
data.frame(
key = c(1, 1, 1, 2, 2, 2, 3, 3, 3),
Product_Name = c(
"Table",
"Table",
"Chair",
"Table",
"Bed",
"Bed",
"Sofa",
"Chair",
"Sofa"
),
Product_desc = c("XX", "XX", "YY", "XX", "Z", "ZZZ", "A", "Y", "AA"),
Cost = c(1, 2, 3, 4, 2, 3, 4, 5, 6)
)
UI和服务器代码
ui <- fluidPage(titlePanel("Demo"),
sidebarLayout(
sidebarPanel(
sliderInput(
"key",
"keys",
min = 1,
max = 3,
value = c(1, 3),
step = 1
),
selectInput("Product", "List of Products", choices = NULL),
selectInput(
"Product_d",
"Product Description",
choices = NULL,
multiple = TRUE,
selected = TRUE
),
checkboxInput('all', 'Select All/None'),
actionButton("Button", "ok")
),
mainPanel(tabsetPanel(
type = "tabs",
tabPanel("table_data", DT::dataTableOutput("table"))
))
))
server <- function(input, output, session) {
observeEvent(input$key, {
updateSelectInput(
session,
"Product",
"List of Products",
choices = unique(
Source_Data %>% filter(key %in% input$key) %>% select
(Product_Name)
)
)
})
observeEvent(c(input$key, input$Product, input$all), {
updateSelectInput(
session,
"Product_d",
"Product Description",
choices = unique(
Source_Data %>% filter(key %in% input$key,
Product_Name %in% input$Product) %>% select
(Product_desc)
),
selected = if (input$all)
unique(
Source_Data %>% filter(key %in% input$key,
Product_Name %in% input$Product) %>% select
(Product_desc)
)
}))
output_func <- eventReactive(input$Button, {
key_input <- input$key
Product_input <- input$Product
Product_desc_input <- input$Product_d
cat_input <- input$Product_desc
div_input <- input$divisions
z <-
Source_Data %>% dplyr::arrange (key) %>% dplyr::select(key,
Product_Name,
Product_Desc,
Cost) %>%
dplyr::filter (
key %inrange%
key_input,
Product_Name ==
Product_input,
Product_Desc ==
Product_desc_input
)
return(z)
})
output$table_data <-
DT::renderDataTable({
DT::datatable(output_func())
})
}
任何建议都可以帮助您。
提前感谢
David
您可以在选择的向量中添加类似“所有产品”的内容,然后通过过滤数据框来生成带有selectizeInput
的辅助renderUI
。 (我还将您的df转换为字符,以便unique()
正常工作。)
df <- Source_Data %>% mutate_all(as.character)
library(shiny)
library(dplyr)
ui <- {
fluidPage(
selectizeInput('product_name', 'Product name', choices = c('All products', unique(df$Product_Name)), selected = 'All products', multiple = TRUE),
uiOutput('secondary_select')
)
}
server <- function(input, output, session) {
output$secondary_select <- renderUI({
if ('All products' %in% input$product_name) {
prod_desc <- unique(df$Product_desc)
} else {
df <- df %>% filter(Product_Name == input$product_name)
prod_desc <- unique(df$Product_desc)
}
selectizeInput('product_desc', 'Product description', choices = c('All descriptions', prod_desc))
})
}
shinyApp(ui, server)
这里是一种通过单击按钮选择所有项目的方法:
library(shiny)
js1 <- paste0(c(
"Selectize.prototype.selectall = function(){",
" var self = this;",
" self.setValue(Object.keys(self.options));",
"}"),
collapse = "\n")
js2 <- paste0(c(
"var selectinput = document.getElementById('select');",
"selectinput.selectize.setValue(-1, false);",
"selectinput.selectize.selectall();",
"$('#select + .selectize-control .item').removeClass('active');"),
collapse = "\n")
ui <- fluidPage(
tags$head(tags$script(js1)),
actionButton("selectall", "Select all", onclick = js2),
br(),
selectizeInput("select", "Select", choices = month.name, multiple = TRUE,
options = list(
plugins = list("remove_button")
)
)
)
server <- function(input, output){}
shinyApp(ui, server)