在shinydashboardPlus中关闭或折叠所有框时，请设置警报

Question

我有一个有10个盒子的仪表盘，可以关闭或折叠。所有的盒子id都以" box“开头。当所有的盒子都关闭或折叠时，我正试着设置一个警报按钮。

下面是仪表板的代码：

library(shiny)
library(shinydashboardPlus)

box_create <- function(i){
  shinydashboardPlus::box(tags$p(paste0("Box",i)), 
                          id = paste0("box", i), 
                          closable = TRUE,
                          collapsible = TRUE)
}

all_box <- purrr::map(1:10, ~box_create(.x))

ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(),
  dashboardBody(
    all_box
  )
)

server <- function(input, output, session) {
  
}

shinyApp(ui, server)

我注意到在按下“关闭”或“折叠”按钮时，发亮的按钮会为该框设置显示器=“无”。

​

那么，是否可以提取与id相关的所有样式，该id以“box”开头，并使用jQuery检查是否所有样式属性集都为“none”？

Answer 1

使用shinydashboardPlus的dev版本，您可以通过它的id (模式：input$mybox$collapsed)访问盒子状态。

请看这个相关文章。

通过devtools::install_github("RinteRface/shinydashboardPlus")安装

library(shiny)
library(tools)
library(shinydashboard)
library(shinydashboardPlus)

box_ids <- paste0("box", 1:10)

box_create <- function(box_id){
  shinydashboardPlus::box(tags$p(toTitleCase(box_id)), 
                          id = box_id, 
                          closable = TRUE,
                          collapsible = TRUE)
}

all_boxes <- lapply(box_ids, box_create)

ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(),
  dashboardBody(
    all_boxes
  )
)

server <- function(input, output, session) {
  observe({
    if(all(sapply(box_ids, function(box_id){input[[box_id]]$collapsed}))){
      showModal(modalDialog("All boxes are collapsed!"))
    }
  })

  # observe({
  #   print(paste("Is box1 collapsed?", input$box1$collapsed))
  # })
  
}

shinyApp(ui, server)

​

​

Answer 2

我以为你想要一个按钮当所有的或都关闭了。这是一个解决办法。

library(shiny)
library(shinydashboard)
library(shinydashboardPlus)

box_create <- function(i){
  shinydashboardPlus::box(tags$p(paste0("Box",i)), 
                          id = paste0("box", i), 
                          closable = TRUE,
                          collapsible = TRUE)
}

all_box <- purrr::map(1:10, ~box_create(.x))

ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(),
  dashboardBody(
    all_box,
    div(id = "alert_button")
  )
)

server <- function(input, output, session) {
  observe({
    boxes <- paste0("box", 1:10)
    visible_status <- sapply(boxes, \(x) input[[x]]$visible)
    collapsed_status <- sapply(boxes, \(x) input[[x]]$collapsed)
    if (!any(visible_status) || all(collapsed_status)) {
      insertUI(
        selector = "#alert_button",
        ui = div(id = "added", actionButton("btn","all hidden OR all collapsed"))
      )
    } else {
      removeUI(selector = "#added")
    }
  })
  
}

shinyApp(ui, server)