if (interactive()) {
library(shiny)
library(bs4Dash)
shinyApp(
ui = dashboardPage(
header = dashboardHeader(),
sidebar = dashboardSidebar(id = "sidebar"),
body = dashboardBody(
actionButton(inputId = "sidebarToggle", label = "Toggle Sidebar")
)
),
server = function(input, output, session) {
observeEvent(input$sidebar, {
if (input$sidebar) {
showModal(modalDialog(
title = "Alert",
"The sidebar is opened.",
easyClose = TRUE,
footer = NULL
))
}
})
observeEvent(input$sidebarToggle, {
updateSidebar(id = "sidebar", session = session)
})
observe({
print(input$sidebar)
})
}
)
}
if (interactive()) {
# sidebarItem with conditional value
library(shiny)
library(bs4Dash)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
sidebarMenu(
id = "sidebarMenu",
menuItem(
text = "Tab 1",
tabName = "tab1"
),
menuItem(
condition = "input.show == true",
text = "Tab 2",
tabName = "tab2"
)
)
),
dashboardBody(
tabItems(
tabItem(
tabName = "tab1",
h1("Welcome!"),
checkboxInput("show", "Show Tab 2", FALSE)
),
tabItem(
tabName = "tab2",
h1("Hey! You found me!")
)
)
)
)
server <- function(input, output) {}
shinyApp(ui = ui, server = server)
}
## Only run this example in interactive R sessions
if (interactive()) {
library(shiny)
library(bs4Dash)
shinyApp(
ui = dashboardPage(
header = dashboardHeader(skin = "dark"),
body = dashboardBody(
tabItems(
tabItem(
tabName = "tab1",
sliderInput("obs", "Number of observations:",
min = 0, max = 1000, value = 500
),
plotOutput("distPlot")
),
tabItem(
tabName = "tab2",
checkboxGroupInput(
"variable", "Variables to show:",
c(
"Cylinders" = "cyl",
"Transmission" = "am",
"Gears" = "gear"
)
),
tableOutput("data")
),
tabItem(
tabName = "tab3",
checkboxInput("val", "Some value", FALSE),
textOutput("value")
),
tabItem(
tabName = "tab4",
"Nothing special here!"
),
tabItem(
tabName = "tab5",
"Tab 5"
),
tabItem(
tabName = "tab6",
"Tab 6"
),
tabItem(
tabName = "tab7",
"Tab 7"
)
)
),
sidebar = dashboardSidebar(
skin = "light",
inputId = "sidebarState",
sidebarMenu(
id = "sidebar",
menuItem(
text = "Tab 1",
tabName = "tab1",
icon = icon("van-shuttle")
),
menuItem(
text = "Tab 2",
tabName = "tab2",
icon = icon("shuttle-space"),
selected = TRUE
),
menuItem(
text = "Item List 1",
icon = icon("bars"),
startExpanded = TRUE,
menuSubItem(
text = "Item 3",
tabName = "tab3",
icon = icon("circle")
),
menuSubItem(
text = "Item 4",
tabName = "tab4",
icon = icon("circle")
)
),
menuItem(
text = "Item List 2",
icon = icon("bars"),
startExpanded = FALSE,
menuSubItem(
text = "Item 5",
tabName = "tab5",
icon = icon("circle")
),
menuSubItem(
text = "Item 6",
tabName = "tab6",
icon = icon("circle")
)
),
menuItem(
text = "Tab 7",
tabName = "tab7",
icon = icon("house")
)
)
),
controlbar = dashboardControlbar(
skin = "light",
sliderInput(
inputId = "controller",
label = "Update the first tabset",
min = 1,
max = 6,
value = 2
)
),
footer = bs4DashFooter()
),
server = function(input, output, session) {
observe(print(input$sidebarItemExpanded))
observe(print(input$sidebar))
# update tabset1
observeEvent(input$controller,
{
updateTabItems(
session,
inputId = "sidebar",
selected = paste0("tab", input$controller)
)
},
ignoreInit = TRUE
)
output$distPlot <- renderPlot({
hist(rnorm(input$obs))
})
output$data <- renderTable(
{
mtcars[, c("mpg", input$variable), drop = FALSE]
},
rownames = TRUE
)
output$value <- renderText({
input$val
})
}
)
}
Run the code above in your browser using DataLab