Есть ли возможность предотвратить закрытие dropdown () при использовании pickerInput () внутри R с блестящим R? - PullRequest
0 голосов
/ 18 апреля 2020

Так что, как гласит заголовок, я пытаюсь создать выпадающий список 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)
...