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

Question

我在使用 shiny.semantic 包和 pickerInput 时需要帮助。我的目的是让我闪亮的应用程序响应迅速，并在桌面和移动设备上都能很好地显示。它在除 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 在再次点击时正常折叠，就像它使用 shiny 一样？

谢谢

Answer 1

由于某些 CSS classes 在 {shiny} Bootstrap UI 框架 {shiny.semantic} 语义 UI，您会遇到某些扩展程序包的意外行为。

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

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);
});

连接 shiny 后执行此操作的原因是为了确保“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)

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

pickerInput not working properly with grid_template from shiny.semantic

r

shiny

semantic-ui

app.R

www/updateMonthInput.js

额外

桌面

手机