R闪亮的可折叠侧边栏

Question

我在 R shiny 中创建了以下应用程序模板：

 library(shiny)
 library(shinyjs)

 ui <- fluidPage(
 useShinyjs(),
 navbarPage("",actionButton("toggleSidebar", "toggle", icon = 
 icon("database")),
          tabPanel("tab",
                  div( id ="Sidebar",sidebarPanel(
                  )),mainPanel() ))))


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


 shinyApp(ui, server)

该应用程序将在边栏中创建一个切换按钮。该按钮应该出现在导航栏中，而不是在侧边栏上方。实际的切换按钮出现在单词选项卡旁边。然而，它是不可见的。

Answer 1

你提到的不可见的部分实际上是你有“”的空标题参数。如下所示将切换按钮放在标题位置：

 library(shiny)
 library(shinyjs)

 ui <- fluidPage(
 useShinyjs(),
 navbarPage(actionButton("toggleSidebar", "toggle", icon = 
 icon("database")),
          tabPanel("tab",
                  div( id ="Sidebar",sidebarPanel(
                  )),mainPanel() )))


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


 shinyApp(ui, server)

Answer 2

我用多个 tabPanel 做了一个例子。

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)

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

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

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)

R闪亮的可折叠侧边栏

R shiny collapsible sidebar

r

shiny

sidebar

collapsable