Question

基于这个问题R shinyjs shinydashboard box uncollapse on action button input和问题How to manually collapse a box in shiny dashboard，我想用actionButton（或radioButtons）代替selectInput。下面是一个可重现的示例。当我单击“是”时，我希望框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)

Answer 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)

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

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

以下是一个最小的工作示例（如果您在应用目录中名为custom.js的目录中名为www的文件中包含上述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)

R ShinyJS Shinydashboard框在radionButtons输入上崩溃

2 个答案: