如何在闪亮的应用程序中折叠侧边栏面板？

Posted 2023-03-24

【中文标题】如何在闪亮的应用程序中折叠侧边栏面板？

【英文标题】：How to collapse sidebarPanel in shiny app?

【发布时间】：2017-06-28 19:50:08

【问题描述】：

我有一个闪亮的应用程序，在 navbarPage 的 tabPanel 内有一个 mainPanel 和一个 sidebarPanel。我需要一个选项来隐藏与此类似的侧边栏面板：Hide sidebar in default in shinydashboard 和 https://github.com/daattali/shinyjs/issues/43。

一个 actionButton 应该控制 sidebarPanel 是显示还是折叠。

这是代码：

library(shiny)
library(shinyjs)

ui <- fluidPage(
  navbarPage("",
             tabPanel("tab",
                      sidebarPanel(
                        useShinyjs()
                      ),
                  
                      mainPanel(actionButton("showSidebar", "Show sidebar"),
                                actionButton("hideSidebar", "Hide sidebar")
                      )
             )
  )
)

server <-function(input, output, session) 
  observeEvent(input$showSidebar, 
    shinyjs::removeClass(selector = "body", class = "sidebarPanel-collapse")
  )
  observeEvent(input$hideSidebar, 
    shinyjs::addClass(selector = "body", class = "sidebarPanel-collapse")
  )


shinyApp(ui, server)

【参考方案1】：

我已修改您的代码以隐藏和显示侧边栏。要为sidebarPanel创建id，我已将它包含在div 中并给它id = Sidebar。为了显示和隐藏侧边栏，我使用了shinyjs 函数show 和hide，ID 为Sidebar。

library(shiny)
library(shinyjs)

ui <- fluidPage(
  useShinyjs(),
  navbarPage("",
             tabPanel("tab",
                      div( id ="Sidebar",sidebarPanel(
                      )),
                      
                      
                      mainPanel(actionButton("showSidebar", "Show sidebar"),
                                actionButton("hideSidebar", "Hide sidebar")
                      )
             )
  )
)

server <-function(input, output, session) 
  observeEvent(input$showSidebar, 
    shinyjs::show(id = "Sidebar")
  )
  observeEvent(input$hideSidebar, 
    shinyjs::hide(id = "Sidebar")
  )


shinyApp(ui, server)

【讨论】：

不错的答案，谢谢 (+1)，但最好只用一个按钮使用 shinyjs::toggle

是的，这绝对是一个更好的选择。答案只是内联提出的问题和提供的代码。我一定会很快根据您的建议编辑我的答案。

【参考方案2】：

以前的 cmets 中建议的切换选项示例。

library(shiny)
library(shinyjs)

ui <- fluidPage(
  useShinyjs(),
  navbarPage("",
             tabPanel("tab",
                      div( id ="Sidebar",sidebarPanel(
                      )),


                      mainPanel(actionButton("toggleSidebar", "Toggle sidebar")
                      )
             )
  )
)

server <-function(input, output, session) 
  observeEvent(input$toggleSidebar, 
    shinyjs::toggle(id = "Sidebar")
  )


shinyApp(ui, server)

【参考方案3】：

我用导航栏和多个选项卡上的切换按钮做了一个例子。

library(shiny)
library(shinyjs)

ui <- fluidPage(
  useShinyjs(),
  navbarPage(title = tagList("title",actionLink("sidebar_button","",icon = icon("bars"))),
             id = "navbarID",
             tabPanel("tab1",
                      div(class="sidebar"
                          ,sidebarPanel("sidebar1")
                      ),
                      mainPanel(
                        "MainPanel1"
                      )
             ),
             tabPanel("tab2",
                      div(class="sidebar"
                          ,sidebarPanel("sidebar2")
                      ),
                      mainPanel(
                        "MainPanel2"
                      )
             )
  )
)

server <-function(input, output, session) 
  
  observeEvent(input$sidebar_button,
    shinyjs::toggle(selector = ".sidebar")
  )
  


shinyApp(ui, server)

========================================

我创建了一个不使用侧面板类的更简单示例，但我不确定它是否适用于所有环境。

library(shiny)
library(shinyjs)

ui <- fluidPage(
  useShinyjs(),
  navbarPage(title = tagList("title",actionLink("sidebar_button","",icon = icon("bars"))),
             tabPanel("tab1",
                      sidebarPanel("sidebar1"),
                      mainPanel("MainPanel1")
             ),
             tabPanel("tab2",
                      sidebarPanel("sidebar2"),
                      mainPanel("MainPanel2")
             )
  )
)

server <-function(input, output, session) 
  observeEvent(input$sidebar_button,
    shinyjs::toggle(selector = ".tab-pane.active div:has(> [role='complementary'])")
  )


shinyApp(ui, server)

========================================

我终于完成了我的可折叠侧边栏面板，shinyjs runjs 允许您在侧边栏面板折叠时扩展主面板的宽度。

library(shiny)
library(shinyjs)

ui <- fluidPage(
  useShinyjs(),
  navbarPage(title = tagList("title",actionLink("sidebar_button","",icon = icon("bars"))),
             tabPanel("tab1",
                      sidebarPanel("sidebar1",width=3),
                      mainPanel("MainPanel1",width=9,style="background-color:gray")
             ),
             tabPanel("tab2",
                        sidebarPanel("sidebar2",width=5)
                        ,mainPanel("MainPanel2",width=7,style="background-color:gray")
             )
  )
)

server <-function(input, output, session) 
  observeEvent(input$sidebar_button,
    shinyjs::toggle(selector = ".tab-pane.active div:has(> [role='complementary'])")
    
    js_maintab <- paste0('$(".tab-pane.active div[role=',"'main'",']")')
    
    runjs(paste0('
          width_percent = parseFloat(',js_maintab,'.css("width")) / parseFloat(',js_maintab,'.parent().css("width"));
          if (width_percent == 1)
            ',js_maintab,'.css("width","");
           else 
            ',js_maintab,'.css("width","100%");
          
          '))
  )


shinyApp(ui, server)

【讨论】：

我能够创建一个运行良好的示例，但是有一个问题：隐藏 sidebarPanel 不会将 mainPanel 的宽度扩展到全屏。隐藏 sidebarPanel 不会使 mainPanel 变宽，因此隐藏它的意义不大。我还需要使用闪亮仪表板吗？

我终于完成了我的可折叠侧边栏面板，shinyjs runjs 允许您在侧边栏面板折叠时扩展主面板的宽度。谢谢。