R shinyjs shinydashboard 框在 radionButtons 输入上展开答案

【问题标题】：R shinyjs shinydashboard box uncollapse on radionButtons inputR shinyjs shinydashboard 框在 radionButtons 输入上展开
【发布时间】：2019-08-07 15:35:45
【问题描述】：

基于这个问题R shinyjs shinydashboard box uncollapse on action button input 和问题How to manually collapse a box in shiny dashboard，我想用radioButtons（或selectInput）替换actionButton。下面是一个可重现的例子。当我单击是时，我希望框 id=B2 和 id=B3 折叠，当我单击否时，框 id =B1 和 id =B3 折叠，当单击可能时，框 id=B1 和 id=B2 折叠。使用下面的代码，有一个崩溃，但它没有按预期工作。

library(shiny)
library(shinyBS)
library(dplyr)
library(shinydashboard)


# javascript code to collapse box
jscode <- "
shinyjs.collapse = function(boxid) {
$('#' + boxid).closest('.box').find('[data-widget=collapse]').click();
}
"

#Design sidebar
sidebar <- dashboardSidebar(width = 225, collapsed=F, 
                            sidebarMenu(id="tabs",
                                        menuItem("zz", tabName = "zz", selected=TRUE)))

#Design body 
body <- dashboardBody(shinyjs:::useShinyjs(), 
                      shinyjs:::extendShinyjs(text = jscode),
                      tabItems(
                        tabItem(tabName = "zz", 
                                fluidRow(box(radioButtons('go','Go', choices = c("yes", "no", "maybe"))),
                                         box(id="B1", collapsible=T,  status = "primary", color="blue", solidHeader = T, 
                                             title="Test"),
                                         box(id="B2", collapsible=T,  status = "primary", color="blue", solidHeader = T, 
                                             title="Test2"),
                                         box(id="B3", collapsible=T,  status = "primary", color="blue", solidHeader = T, 
                                             title="Test3")

                                         ))
                        ))

Header <- dashboardHeader()

#Show title and the page (includes sidebar and body)
ui <- dashboardPage(Header, sidebar, body)


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

  observeEvent(input$go == "yes",

               {js$collapse("B2", "B3")}

  )
  #
  observeEvent(input$go == "no",

               {js$collapse("B1", "B3")}
  )

  observeEvent(input$go == "maybe",

               {js$collapse("B1", "B2")}
  )

})

shinyApp( ui = ui, server = server)

【问题讨论】：

您的折叠功能有效。要检查框是否折叠，您可以使用此处描述的功能：stackoverflow.com/questions/45462614/…
@Wilmar van Ommeren，是的，有一个崩溃，但它没有按预期工作。 For example, when yes is selected, only id=B2 and id=B3 should be collapsed.因为它是 id=B3 没有崩溃。
这是因为此功能不会折叠框，而是切换它们。因此，如果一个盒子已经折叠，它将打开而不是保持折叠状态。因此，您应该添加一个检查框是否已折叠的函数。
@Wilmar van Ommeren。您提供的链接告诉它是否已折叠。我添加了代码，但是如何实现这个功能来帮助我解决我的问题。我对JS一无所知。

标签： r shiny shinyjs

【解决方案1】：

您提供的折叠功能实际上会切换框，而不仅仅是折叠它们。因此，在应用此功能之前，您首先必须检查一个框是否已经折叠。这可以通过此处描述的函数来完成：How to see if a shiny dashboard box is collapsed from the server side。

如果您还想打开剩余的框，您可以使用相同的功能。

此外，您可以将所有内容放在一个观察者中，以使您的代码更加一致。

工作示例：

library(shiny)
library(shinyBS)
library(dplyr)
library(shinydashboard)
library(shinyjs)

# javascript code to collapse box
jscode <- "
shinyjs.collapse = function(boxid) {
$('#' + boxid).closest('.box').find('[data-widget=collapse]').click();
}
"

collapseInput <- function(inputId, boxId) {
  tags$script(
    sprintf(
      "$('#%s').closest('.box').on('hidden.bs.collapse', function () {Shiny.onInputChange('%s', true);})",
      boxId, inputId
    ),
    sprintf(
      "$('#%s').closest('.box').on('shown.bs.collapse', function () {Shiny.onInputChange('%s', false);})",
      boxId, inputId
    )
  )
}

#Design sidebar
sidebar <- dashboardSidebar(width = 225, collapsed=F, 
                            sidebarMenu(id="tabs",
                                        menuItem("zz", tabName = "zz", selected=TRUE)))

#Design body 
body <- dashboardBody(shinyjs:::useShinyjs(), 
                      shinyjs:::extendShinyjs(text = jscode),
                      tabItems(
                        tabItem(tabName = "zz", 
                                fluidRow(box(radioButtons('go','Go', choices = c("yes", "no", "maybe"))),
                                         box(id="B1", collapsible=T,  status = "primary", color="blue", solidHeader = T, 
                                             title="Test"),
                                         collapseInput(inputId = "iscollapsebox1", boxId = "B1"),
                                         box(id="B2", collapsible=T,  status = "primary", color="blue", solidHeader = T, 
                                             title="Test2"),
                                         collapseInput(inputId = "iscollapsebox2", boxId = "B2"),
                                         box(id="B3", collapsible=T,  status = "primary", color="blue", solidHeader = T, 
                                             title="Test3"),
                                         collapseInput(inputId = "iscollapsebox3", boxId = "B3")
                                ))
                      ))

Header <- dashboardHeader()

#Show title and the page (includes sidebar and body)
ui <- dashboardPage(Header, sidebar, body)

server <- shinyServer(function(input, output, session){
  observeEvent(input$go,{
    box1_collapsed = F
    box2_collapsed = F
    box3_collapsed = F
    if (!is.null(input$iscollapsebox1)){
      box1_collapsed <- input$iscollapsebox1
    }
    if (!is.null(input$iscollapsebox2)){
      box2_collapsed <- input$iscollapsebox2
    }
    if (!is.null(input$iscollapsebox3)){
      box3_collapsed <- input$iscollapsebox3
    }
    if (input$go == 'yes'){
      if (!box2_collapsed){
        js$collapse("B2")}
      if (!box3_collapsed){
        js$collapse("B3")}
      # if you want to open B1
      if (box1_collapsed){
        js$collapse("B1")}
    } else if (input$go == 'no'){
      if (!box1_collapsed){
        js$collapse("B1")}
      if (!box3_collapsed){
        js$collapse("B3")}
      # if you want to open B2
      if (box2_collapsed){
        js$collapse("B2")}
    } else if (input$go == 'maybe'){
      if (!box1_collapsed){
        js$collapse("B1")}
      if (!box2_collapsed){
        js$collapse("B2")}
      # if you want to open B3
      if (box3_collapsed){
        js$collapse("B3")}
    }
  })
})

shinyApp( ui = ui, server = server)

【讨论】：

【解决方案2】：

您可以将以下函数添加到外部www/custom.js 文件中

closeBox = function(boxid) {
  var box = $('#' + boxid).closest('.box');
  if (!box.hasClass('collapsed-box')) {
    box.find('[data-widget=collapse]').click();
  }
};

openBox = function(boxid) {
  var box = $('#' + boxid).closest('.box');
  if (box.hasClass('collapsed-box')) {
    box.find('[data-widget=collapse]').click();
  }
};

在dashboardBody 中包含.js 文件，并在您的应用脚本中使用shinyjs::runjs("openBox('box_id')") 或shinyjs::runjs("closeBox('box_id')") 调用该函数。

以下是一个最小的工作示例（如果您在 app 目录中名为 www 的目录中的一个名为 custom.js 的文件中包含上述 javascript）。

library(shiny)
library(shinyjs)
library(shinydashboard)

ui <- dashboardPage(
    skin = "red",
    dashboardHeader(title = "Demo"),
    dashboardSidebar(
        actionButton("open", "Open Box"),
        actionButton("close", "Close Box")
    ),
    dashboardBody(
        shinyjs::useShinyjs(),
        tags$head(
            tags$link(rel = "stylesheet", type = "text/css", href = "custom.css"),
            tags$script(src = "custom.js")
        ),
        box(id = 'x',
            collapsible = T,
            collapsed = T,
            solidHeader = TRUE,
            title = 'Box',
            p("Hello"))
    )
)

# Define server logic required to draw a histogram
server <- function(input, output) {
    observeEvent(input$open, {
        shinyjs::runjs("openBox('x')")
    }, ignoreNULL = TRUE)

    observeEvent(input$close, {
        shinyjs::runjs("closeBox('x')")
    }, ignoreNULL = TRUE)
}

# Run the application
shinyApp(ui = ui, server = server)

【讨论】：