我正在尝试制作多页的闪亮仪表板。我希望在选择页面时，边栏能够折叠，并能够重新打开它以选择新页面。例如，当您选择第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)
答案 0 :(得分：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。另外，我删除了您的观察者，因为我不知道您想要实现什么。最后，我减小了标题的宽度，因为否则显示侧边栏的按钮被隐藏了。