在闪亮的仪表板中关闭侧边栏答案

【问题标题】：closing sidebar in shiny dashboard在闪亮的仪表板中关闭侧边栏
【发布时间】：2020-10-21 02:48:12
【问题描述】：

我正在尝试制作一个多页闪亮的仪表板。当您选择一个页面时，我希望侧边栏可以折叠，并且能够重新打开它以选择一个新页面。例如，当您选择第 2 页时，侧边栏会折叠，如果您想返回第 1 页，可以稍后重新打开它。现在它处于打开状态，即当您单击第 2 页时，侧边栏不会折叠。我使用了 useShinyjs()，这就是我认为它可以折叠而没有运气的原因。非常感谢任何帮助:)

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

Stores <- data.frame(Store = c("Store 1", "Store 2", "Store 3", "Store 4", "Store 5"),
                     Sales = c(8247930, 423094, 204829, 903982, 7489472, 429085, 208955, 7492852, 5285034, 2958275,1598753, 28487593, 4892049, 583042, 509275, 5904728, 5098325, 5920947, 4920946, 2049583),
                     Avg_cust = c(325,542,582,482,904, 594, 304, 493, 690, 403, 694, 104, 493, 596, 403, 506, 304, 305, 632, 478),
                     Year = c(rep(2012,5), rep(2013,5), rep(2014,5), rep(2015,5)))

ui <- dashboardPage(
  header = dashboardHeader(
    title = "Store Performance",
    titleWidth = "100%"),
  sidebar = dashboardSidebar(
    useShinyjs(),
    width = 200,
    collapsed = FALSE,
    sidebarMenu(id = "tabs",
                menuItem("Page 1", tabName = "pg1"),
                menuItem("Page 2", tabName = "pg2"))),
  skin = "black",
  body = dashboardBody(
    useShinyjs(),
    tabItems(
      tabItem("pg1",
              fluidRow(
                column(width = 3,
                       box(
                         title = "Options",
                         status = 'warning',
                         solidHeader = TRUE,
                         width = 12,
                         collapsible = FALSE,
                         collapsed = FALSE,
                         pickerInput(
                           inputId = "YR",
                           label = "Year:",
                           choices = c(2012,2013,2014,2015),
                           selected = 2015,
                           multiple = FALSE))),
                column(width = 9,
                       boxPlus(plotlyOutput("All"),
                               status = 'warning',
                               width = 12,
                               solidHeader = TRUE,
                               collapsible = FALSE,
                               closable = FALSE,
                               collapsed = FALSE)))),
      tabItem("pg2",
              fluidRow(
                column(width = 9,
                       boxPlus(title = "Add graph here",
                               width = 12,
                               status = "warning",
                               solidHeader = TRUE,
                               collapsible = FALSE,
                               closable = FALSE,
                               collapsed = FALSE)),
                column(width = 3,
                       box(
                         title = "Options",
                         status = 'warning',
                         solidHeader = TRUE,
                         width = 12,
                         collapsible = FALSE,
                         collapsed = FALSE,
                         pickerInput(
                           inputId = "st",
                           label = "Store:",
                           choices = unique(Stores$Store),
                           selected = "Store 1",
                           multiple = FALSE
                         ))))))))

server <- function(input, output) {
  observeEvent({
    input$YR
  },
  
  output$All <- renderPlotly({
    plot_ly(Stores[Stores$Year == input$YR,], x = ~Avg_cust, y = ~Sales,
            hoverinfo = "text", text = ~Store)%>%
      layout(title = "Store Performance",
             xaxis = list(title = "Customers"),
             yaxis = list(title = "Sales"))
  })
  )
  }

shinyApp(ui = ui, server = server)

【问题讨论】：

标签： r shiny

【解决方案1】：

只使用useShinyjs() 是不行的。它只设置了shinyjs，但你需要告诉它要做什么。这里的想法是将类“sidebar-collapse”添加到正文中，因为这会隐藏侧边栏。如果切换选项卡，侧边栏应始终隐藏，因此必须添加一个观察者来监听选项卡是否切换。然后你可以使用shinyjs 来添加带有addClass 的类。 tabswitch的输入是sidebarMenu的id：

library(shiny)
library(dplyr)
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(shinyjs)
library(shinyWidgets)
library(shinyBS)
library(plotly)

Stores <- data.frame(Store = c("Store 1", "Store 2", "Store 3", "Store 4", "Store 5"),
                     Sales = c(8247930, 423094, 204829, 903982, 7489472, 429085, 208955, 7492852, 5285034, 2958275,1598753, 28487593, 4892049, 583042, 509275, 5904728, 5098325, 5920947, 4920946, 2049583),
                     Avg_cust = c(325,542,582,482,904, 594, 304, 493, 690, 403, 694, 104, 493, 596, 403, 506, 304, 305, 632, 478),
                     Year = c(rep(2012,5), rep(2013,5), rep(2014,5), rep(2015,5)))

ui <- dashboardPage(
  header = dashboardHeader(
    title = "Store Performance"),
  sidebar = dashboardSidebar(
    width = 200,
    collapsed = FALSE,
    sidebarMenu(id = "tabs",
                menuItem("Page 1", tabName = "pg1"),
                menuItem("Page 2", tabName = "pg2"))),
  skin = "black",
  body = dashboardBody(
    useShinyjs(),
    tabItems(
      tabItem("pg1",
              fluidRow(
                column(width = 3,
                       box(
                         title = "Options",
                         status = 'warning',
                         solidHeader = TRUE,
                         width = 12,
                         collapsible = FALSE,
                         collapsed = FALSE,
                         pickerInput(
                           inputId = "YR",
                           label = "Year:",
                           choices = c(2012,2013,2014,2015),
                           selected = 2015,
                           multiple = FALSE))),
                column(width = 9,
                       box(plotlyOutput("All"),
                               status = 'warning',
                               width = 12,
                               solidHeader = TRUE,
                               collapsible = FALSE,
                               closable = FALSE,
                               collapsed = FALSE)))),
      tabItem("pg2",
              fluidRow(
                column(width = 9,
                       box(title = "Add graph here",
                               width = 12,
                               status = "warning",
                               solidHeader = TRUE,
                               collapsible = FALSE,
                               closable = FALSE,
                               collapsed = FALSE)),
                column(width = 3,
                       box(
                         title = "Options",
                         status = 'warning',
                         solidHeader = TRUE,
                         width = 12,
                         collapsible = FALSE,
                         collapsed = FALSE,
                         pickerInput(
                           inputId = "st",
                           label = "Store:",
                           choices = unique(Stores$Store),
                           selected = "Store 1",
                           multiple = FALSE
                         ))))))))

server <- function(input, output) {
  
  output$All <- renderPlotly({
    plot_ly(Stores[Stores$Year == input$YR,], x = ~Avg_cust, y = ~Sales,
            hoverinfo = "text", text = ~Store)%>%
      layout(title = "Store Performance",
             xaxis = list(title = "Customers"),
             yaxis = list(title = "Sales"))
  })
  
  observeEvent(input$tabs, {
    addClass(selector = "body", class = "sidebar-collapse")
  })
  
  
  
}

shinyApp(ui = ui, server = server)

顺便说一句：您还需要包shinydashboardPlus。另外，我删除了您的观察者，因为我不知道您想要实现什么。最后，我减小了标题的宽度，否则显示侧边栏的按钮会被隐藏。

有关其工作原理的更多信息，请查看here 和here。

【讨论】：