R shinyjs shinydashboard 框在 radionButtons 输入上展开

Question

基于这个问题 and question ，我想将 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

您提供的折叠功能实际上会切换框，而不仅仅是折叠它们。因此，在应用此功能之前，您首先必须检查一个框是否已经折叠。这可以通过此处描述的函数来完成：.

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

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

工作示例：

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

在 dashboardBody 中包含 .js 文件并使用 shinyjs::runjs("openBox('box_id')") 或 shinyjs::runjs("closeBox('box_id')").

在您的应用程序脚本中调用函数

以下是一个最小的工作示例（如果您将上面的 javascript 包含在应用程序目录中名为 www 的目录中名为 custom.js 的文件中。

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 输入上展开

R shinyjs shinydashboard box uncollapse on radionButtons input

r

shiny

shinyjs