Так что, как гласит заголовок, я пытаюсь создать выпадающий список R блестящий с несколькими входами pickerInputs внутри них. Я знаю, что необходимо использовать dropdown, а не dropdownBttn из-за проблемы совместимости bootstrap. Когда я открываю выпадающий список, я вижу все свои фильтры без проблем. Даже когда я нажимаю на один из pickerInputs, виджет работает без проблем. Однако, когда я пытаюсь щелкнуть по другому входу средства выбора или просто закрыть раскрывающийся список средства выбора, все раскрывающееся меню закрывается. Как пользователь это было бы действительно раздражающим. Я знаю, что мог бы просто использовать опции-флажки или даже другой виджет, учитывая, что в приведенном ниже примере используется только набор данных автомобилей, но я хочу иметь возможность расширить его до наборов данных, где может быть больше 4 вариантов, а pickerInput может быть лучшим виджетом для фильтрации. Я включил свой код ниже для работоспособного примера проблемы.
# *LIBRARIES* ----
library(shiny)
library(shinyWidgets)
library(shinydashboard)
# *UI* ----
ui <- shinyUI(
# Main Dashboard Page
dashboardPage(
skin = "green",
# Dashboard Header Settings ----
dashboardHeader(
title = "Dashboard Showcase",
# Notifications Bar ----
dropdownMenu(
type = "notifications",
icon = icon("warning")
),
dropdownMenu(
type = "messages",
icon = icon("envelope")
),
dropdownMenu(
type = "tasks",
icon = icon("clipboard")
)
),
# Dashboard Sidebar ----
dashboardSidebar(
# Tab Navigation Menu ----
sidebarMenu(
menuItem("Main Dashboard",
tabName = "tab1",
icon = icon("dashboard")
),
menuItem("Dynamic Graph",
tabName = "tab2",
icon = icon("chart-line")
)
)
),
# Dashboard Body ----
dashboardBody(
# Dropdown Filter selection ----
dropdown(
size = "lg",
icon = icon("filter"),
label = "Filters",
uiOutput("mainfilters")
),
# Creating Dynamic Tabs ----
tabItems(
tabItem(
tabName = "tab1",
class = "active"
),
tabItem(
tabName = "tab2"
)
)
)
)
)
# *SERVER* ----
server <- function(input, output){
# Data Initialization ----
mydata <- mtcars
# Filters ----
output$mainfilters <- renderUI({
list(
# Place your input filters in list form here
fluidRow(column(6,
pickerInput(
inputId = "gearfilter",
label = "Select Number of Gears",
choices = as.character(sort(unique(mydata$gear),
decreasing = FALSE
)
),
selected = as.character(unique(mydata$gear)),
multiple = TRUE,
options = list(
`actions-box` = TRUE
)
)
),
column(6,
pickerInput(
inputId = "cylinderfilter",
label = "Select Number of Cylinders",
choices = as.character(unique(mydata$cyl)),
selected = as.character(unique(mydata$cyl)),
multiple = TRUE,
# New updated options to use the live searching function of the widget.
options = pickerOptions(
actionsBox = TRUE,
selectedTextFormat = 'count>2',
liveSearch = T)
)
)
),
fluidRow(column(6,
pickerInput(
inputId = "vsfilter",
label = "Select Engine Type: ",
choices = as.character(unique(mydata$vs)),
selected = as.character(unique(mydata$vs)),
multiple = TRUE,
# Widget Options
options = pickerOptions(
actionsBox = TRUE
)
)
),
column(6,
pickerInput(
inputId = "trannyfilter",
label = "Select Transmission Type: ",
choices = as.character(unique(mydata$am)),
selected = as.character(unique(mydata$am)),
multiple = TRUE,
# Widget options
options = pickerOptions(
actionsBox = TRUE
)
)
)
)
)
})
# Data Cleaning ----
# Output Options ----
#outputOptions(x = output, name = "mainfilters", suspendWhenHidden = FALSE)
}
shinyApp(ui = ui, server = server)