pickerInput 无法与来自 shiny.semantic 的 grid_template 一起正常工作

Question

我在使用带有 pickerInput 的 shiny.semantic 包时需要帮助。我的目的是让我闪亮的应用程序响应并在桌面和移动设备上都能很好地显示。除了 pickerInput 之外，它在两个设备上都能很好地显示。每当单击 pickerInput 以显示其项目时，再次单击时它不会折叠。见下图

当我不使用 shiny.semantic 包的 grid_template 时，我需要它正常折叠回来。下面是我的脚本

  library(shiny)
  library(shiny.semantic)
  library(leaflet)
  library(shinyWidgets)
  library(shinyjs)
  library(shinycssloaders)
  library(htmlwidgets)
  library(hrbrthemes)
  
  # Interactive Visualizations
  library(plotly)
  library(ggtext)
  
  # Core packages
  library(tidyverse)
  
  library(DBI)
  #library(RMySQL)
  library(RMariaDB)
  library(odbc)
  library(sp)
  years_vector <- c("2020", "2021")
  
  months_vector <-
    c(
      "January",
      "February",
      "March",
      "April",
      "May",
      "June",
      "July",
      "August",
      "September",
      "October",
      "November",
      "December"
    )
  
  
  myGridTemplate <- grid_template(
    default = list(areas = rbind(
      c(
        "search_info1",
        "search_info2",
        "search_info3"
      )),
    mobile = list(
      areas = rbind(
        "search_info1",
        "search_info2",
        "search_info3"
      ),
      rows_height = c(
        "100px",
        "100px",
        "100px"
      ),
      cols_width = c("100%")
    )))
  
  #display_grid(myGridTemplate)
  ui <- semanticPage(
    grid(
      myGridTemplate,
      search_info1 = shiny::column(
        id = "column_selector_year",
        width = 2,
        offset = 3,
        shinyWidgets::pickerInput(
          inputId  = "picker_year",
          label    = h5("Select Year "),
          choices  = c("2020", "2021"),
          selected = "2020",
          multiple = FALSE,
          options  = list(
            `actions-box` = FALSE,
            size = 2,
            `selected-text-format` = "count > 2"
          )
        )
      ),
      search_info2 = shiny::column(
        id = "column_selector_month",
        2,
        shinyWidgets::pickerInput(
          inputId  = "picker_month",
          label    = h5("Select Month"),
          choices  = c(
            "January",
            "February",
            "March",
            "April",
            "May",
            "June",
            "July",
            "August",
            "September",
            "October",
            "November",
            "December"
          ),
          selected = c(
            "January",
            "February",
            "March",
            "April",
            "May",
            "June",
            "July",
            "August",
            "September",
            "October",
            "November",
            "December"
          ),
          multiple = TRUE,
          
          options  = list(
            `actions-box` = TRUE,
            size = 4,
            `selected-text-format` = "count > 2"
          )
        )
      ),
      search_info3 = column(
        id = "column_selector4",
        2,
        br(),
        br(),
        actionButton(inputId = "apply", label = "Update")
      )
    
  ))
  
  server <- function(input, output) {
    
  }
  shinyApp(ui = ui, server = server)

如何让pickerInput在再次单击时正常折叠，就像使用闪亮时一样？

谢谢

Answer 1

由于{shiny} Bootstrap UI 框架{shiny.semantic} Semantic UI 之间的某些 CSS 类发生冲突，您将在使用某些扩展包时遇到一些意想不到的行为。

要使用{shiny.semantic} 编写类似的内容，您可以使用dropdown_input 并添加一点JS。我找不到一种简单的方法来使用按钮自动选择下拉列表中的所有内容，但是为了一键删除所有选项，我添加了“可清除”类。

app.R

library(shiny)
library(shiny.semantic)

myGridTemplate <- shiny.semantic::grid_template(
  default = list(
    areas = rbind(
      c(
        "search_info1",
        "search_info2",
        "search_info3"
      )
    ),
    mobile = list(
      areas = rbind(
        "search_info1",
        "search_info2",
        "search_info3"
      ),
      rows_height = c(
        "100px",
        "100px",
        "100px"
      ),
      cols_width = "100%"
    )
  )
)

ui <- shiny.semantic::semanticPage(
  tags$head(
    tags$script(src = "updateMonthInput.js")
  ),

  shiny.semantic::grid(
    myGridTemplate,
    search_info1 = shiny.semantic::form(
      shiny.semantic::field(
        tags$label("Select Year"),
        shiny.semantic::dropdown_input(
          input_id = "picker_year",
          c(2020, 2021)
        )
      )
    ),
    search_info2 = shiny.semantic::form(
      shiny.semantic::field(
        tags$label("Select Month"),
        shiny.semantic::dropdown_input(
          input_id = "picker_month",
          type = "multiple clearable selection",
          month.name, value = month.name
        )
      )
    ),
    search_info3 = div(
      id = "column_selector4",
      tags$br(),
      shiny.semantic::actionButton(
        inputId = "apply",
        label = "Update"
      )
    )
  )
)

server <- function(input, output) { }

shinyApp(ui = ui, server = server)

www/updateMonthInput.js

$(document).on('shiny:connected', function() {
  var picker_month_values = $('#picker_month').dropdown('get value').split(',');
  $('#picker_month').dropdown('clear');
  $('#picker_month').dropdown({useLabels: false});
  $('#picker_month').dropdown('set exactly', picker_month_values);
});

连接闪亮后执行此操作的原因是确保“X selected”正确显示。需要暂时清除下拉菜单，以防止下拉菜单单独显示所有月份。

额外

我注意到您希望它在移动模式下显示为单列。我建议使用shiny.semantic::form，因为这会以一种简单的方式产生。我重写了上面的网格，向您展示它的样子：

library(shiny)
library(shiny.semantic)

ui <- shiny.semantic::semanticPage(
  tags$head(
    tags$script(src = "updateInput.js")
  ),
  
  shiny.semantic::form(
    shiny.semantic::fields(
      class = "three",
      shiny.semantic::field(
        tags$label("Select Year"),
        shiny.semantic::dropdown_input(
          input_id = "picker_year",
          c(2020, 2021)
        )
      ),
      shiny.semantic::field(
        tags$label("Select Month"),
        shiny.semantic::dropdown_input(
          input_id = "picker_month",
          type = "multiple clearable selection",
          month.name, value = month.name
        )
      ),
      shiny.semantic::field(
        id = "column_selector4",
        tags$br(),
        shiny.semantic::actionButton(
          inputId = "apply",
          label = "Update"
        )
      )
    )
  )
)

server <- function(input, output) { }

shinyApp(ui = ui, server = server)

桌面

手机