侧边栏中有两个菜单项。目前,如果我点击任何菜单项,则会显示所有菜单项的标签项。我希望它可以折叠,如果我点击多个名称菜单,单个分析应该崩溃,如果我点击单个分析,多个应该崩溃。
目前的设计是
可重现的代码是
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Dashboard", titleWidth = 290),
dashboardSidebar(
width = 290,
sidebarMenu(
menuItem(
"Multiple Incident Analysis",
tabName = "dashboard",
icon = icon("th")),
splitLayout(cellWidths = c("44%", "31%", "25%"),
dateInput("datefrom", "Date From:", format = "mm/dd/yyyy", Sys.Date()-5),
textInput("datefrom_hour", "Hour",
value = "12:00"),
textInput("datefrom_noon","AM/PM", value = "AM")),
splitLayout(cellWidths = c("44%", "31%", "25%"),
dateInput("dateto", "Date To:", format = "mm/dd/yyyy"),
textInput("dateto_hour", "Hour",
value = "11:59"),
textInput("dateto_noon","AM/PM", value = "PM")),
menuItem("Single Analysis",
tabName = "widgets",
icon = icon("th")),
numericInput("tckt", "Ticket Number : ", 12345, width = 290),
submitButton("Submit", width = "290")
)),
dashboardBody(
))
shinyApp(ui, server)
我无法在此使用条件面板。
答案 0 :(得分:2)
这是一种使用JavaScript的方法。注意事项:
我们使用ids div
和#mult
在#single
个容器的菜单中打包这些项目。
我们添加JavaScript代码,选择所有菜单按钮(li
元素)并添加点击事件。单击其中一个菜单项时,div
个容器的状态均为toggle
d。
library(shiny)
library(shinydashboard)
server <- function(input, output) { }
jsc <- '
$(document).ready(function () {
$(".sidebar-menu").children("li").on("click", function() {
$("#mult, #single").toggle();
});
});
'
ui <- dashboardPage(
dashboardHeader(title = "Dashboard", titleWidth = 290),
dashboardSidebar(
width = 290,
sidebarMenu(
menuItem(
"Multiple Incident Analysis",
tabName = "dashboard",
icon = icon("th")),
div(id = "mult", splitLayout(cellWidths = c("44%", "31%", "25%"),
dateInput("datefrom", "Date From:", format = "mm/dd/yyyy", Sys.Date()-5),
textInput("datefrom_hour", "Hour",
value = "12:00"),
textInput("datefrom_noon","AM/PM", value = "AM")),
splitLayout(cellWidths = c("44%", "31%", "25%"),
dateInput("dateto", "Date To:", format = "mm/dd/yyyy"),
textInput("dateto_hour", "Hour",
value = "11:59"),
textInput("dateto_noon","AM/PM", value = "PM"))),
menuItem("Single Analysis",
tabName = "widgets",
icon = icon("th")),
div(id = "single", style="display: none;", numericInput("tckt", "Ticket Number : ", 12345, width = 290)),
submitButton("Submit", width = "290")
)),
dashboardBody(
tags$head(tags$script(jsc))
))
shinyApp(ui, server)