Skip to content

Instantly share code, notes, and snippets.

@gadenbuie
Last active March 16, 2024 05:49
Show Gist options
  • Save gadenbuie/74ba1d0a4d597aba20caf1b6bf41922f to your computer and use it in GitHub Desktop.
Save gadenbuie/74ba1d0a4d597aba20caf1b6bf41922f to your computer and use it in GitHub Desktop.
Example apps using bslib v0.5.0
# https://shiny.posit.co/blog/posts/bslib-dashboards/#hello-dashboards
library(shiny)
library(bslib)
library(ggplot2)
# Setup -------------------------------------------------------------------
data(penguins, package = "palmerpenguins")
# Turn on thematic for theme-matched plots
thematic::thematic_shiny(font = "auto")
theme_set(theme_bw(base_size = 16))
# Calculate column means for the value boxes
means <- colMeans(
penguins[c("bill_length_mm", "bill_length_mm", "body_mass_g")],
na.rm = TRUE
)
# UI ----------------------------------------------------------------------
ui <- page_sidebar(
title = "Penguins dashboard",
sidebar = sidebar(
varSelectInput(
"color_by", "Color by",
penguins[c("species", "island", "sex")],
selected = "species"
)
),
layout_columns(
fill = FALSE,
value_box(
title = "Average bill length",
value = scales::unit_format(unit = "mm")(means[[1]]),
showcase = bsicons::bs_icon("align-bottom")
),
value_box(
title = "Average bill depth",
value = scales::unit_format(unit = "mm")(means[[2]]),
showcase = bsicons::bs_icon("align-center"),
theme_color = "dark"
),
value_box(
title = "Average body mass",
value = scales::unit_format(unit = "g", big.mark = ",")(means[[3]]),
showcase = bsicons::bs_icon("handbag"),
theme_color = "secondary"
)
),
layout_columns(
card(
full_screen = TRUE,
card_header("Bill Length"),
plotOutput("bill_length")
),
card(
full_screen = TRUE,
card_header("Bill depth"),
plotOutput("bill_depth")
)
),
card(
full_screen = TRUE,
card_header("Body Mass"),
plotOutput("body_mass")
)
)
# Server ------------------------------------------------------------------
server <- function(input, output) {
gg_plot <- reactive({
ggplot(penguins) +
geom_density(aes(fill = !!input$color_by), alpha = 0.2) +
theme_bw(base_size = 16) +
theme(axis.title = element_blank())
})
output$bill_length <- renderPlot(gg_plot() + aes(bill_length_mm))
output$bill_depth <- renderPlot(gg_plot() + aes(bill_depth_mm))
output$body_mass <- renderPlot(gg_plot() + aes(body_mass_g))
}
# Shiny App ---------------------------------------------------------------
shinyApp(ui, server)
# https://shiny.posit.co/blog/posts/bslib-dashboards/#why-bslib-themable-dashboards
#
# Note: this is the same app as `01-hello-dashboards.R` but with `bs_themer()`
# turned on in the server function.
library(shiny)
library(bslib)
library(ggplot2)
# Setup -------------------------------------------------------------------
data(penguins, package = "palmerpenguins")
# Turn on thematic for theme-matched plots
thematic::thematic_shiny(font = "auto")
theme_set(theme_bw(base_size = 16))
# Calculate column means for the value boxes
means <- colMeans(
penguins[c("bill_length_mm", "bill_length_mm", "body_mass_g")],
na.rm = TRUE
)
# UI ----------------------------------------------------------------------
ui <- page_sidebar(
title = "Penguins dashboard",
sidebar = sidebar(
varSelectInput(
"color_by", "Color by",
penguins[c("species", "island", "sex")],
selected = "species"
)
),
layout_columns(
fill = FALSE,
value_box(
title = "Average bill length",
value = scales::unit_format(unit = "mm")(means[[1]]),
showcase = bsicons::bs_icon("align-bottom")
),
value_box(
title = "Average bill depth",
value = scales::unit_format(unit = "mm")(means[[2]]),
showcase = bsicons::bs_icon("align-center"),
theme_color = "dark"
),
value_box(
title = "Average body mass",
value = scales::unit_format(unit = "g", big.mark = ",")(means[[3]]),
showcase = bsicons::bs_icon("handbag"),
theme_color = "secondary"
)
),
layout_columns(
card(
full_screen = TRUE,
card_header("Bill Length"),
plotOutput("bill_length")
),
card(
full_screen = TRUE,
card_header("Bill depth"),
plotOutput("bill_depth")
)
),
card(
full_screen = TRUE,
card_header("Body Mass"),
plotOutput("body_mass")
)
)
# Server ------------------------------------------------------------------
server <- function(input, output) {
bs_themer()
gg_plot <- reactive({
ggplot(penguins) +
geom_density(aes(fill = !!input$color_by), alpha = 0.2) +
theme_bw(base_size = 16) +
theme(axis.title = element_blank())
})
output$bill_length <- renderPlot(gg_plot() + aes(bill_length_mm))
output$bill_depth <- renderPlot(gg_plot() + aes(bill_depth_mm))
output$body_mass <- renderPlot(gg_plot() + aes(body_mass_g))
}
# Shiny App ---------------------------------------------------------------
shinyApp(ui, server)
# https://shiny.posit.co/blog/posts/bslib-dashboards/#layout-tooling
library(shiny)
library(bslib)
# UI ----------------------------------------------------------------------
ui <- page_sidebar(
title = "Penguins dashboard",
sidebar = sidebar(
varSelectInput(
"color_by", "Color by",
penguins[c("species", "island", "sex")],
selected = "species"
),
hr(),
p(
bsicons::bs_icon("info-circle"),
"Try changing the width of the browser window to see how the layout responds."
)
),
layout_columns(
col_widths = breakpoints(
# two rows at "md" and above, top row equal widths
md = c(6, 6, 12),
# two rows on "lg" and above, negative space in right margin
lg = c(5, 7, -1, 10, -1)
# two rows on "xl" and above, with negative space in left/right margin
xl = c(
-1, 5, 5, -1,
-1, 10, -1
)
),
row_heights = c(1, 2),
card(
full_screen = TRUE,
card_header("Bill Length"),
plotOutput("bill_length")
),
card(
full_screen = TRUE,
card_header("Bill depth"),
plotOutput("bill_depth")
),
card(
full_screen = TRUE,
card_header("Body Mass"),
plotOutput("body_mass")
)
)
)
# Server ------------------------------------------------------------------
server <- function(input, output) {
gg_plot <- reactive({
ggplot(penguins) +
geom_density(aes(fill = !!input$color_by), alpha = 0.2) +
theme_bw(base_size = 16) +
theme(axis.title = element_blank())
})
output$bill_length <- renderPlot(gg_plot() + aes(bill_length_mm))
output$bill_depth <- renderPlot(gg_plot() + aes(bill_depth_mm))
output$body_mass <- renderPlot(gg_plot() + aes(body_mass_g))
}
# Shiny App ---------------------------------------------------------------
shinyApp(ui, server)
# https://shiny.posit.co/blog/posts/bslib-dashboards/#card-level-sidebars
library(bslib)
library(htmltools)
library(crosstalk)
library(plotly)
library(leaflet)
# Create Diamonds view
dat <- SharedData$new(dplyr::sample_n(diamonds, 1000))
sidebar_diamonds <- layout_sidebar(
sidebar = filter_select("cut", "Cut", dat, ~cut),
plot_ly(dat) |> add_histogram(x = ~price)
)
# Create Earthquake view
squake <- SharedData$new(quakes)
sidebar_quakes <- layout_sidebar(
class = "p-0",
sidebar = sidebar(
title = "Earthquakes off Fiji",
bg = "#1E1E1E",
class = "fw-bold font-monospace",
position = "right",
filter_slider("mag", "Magnitude", squake, ~mag, ticks = FALSE)
),
leaflet(squake) |> addTiles() |> addCircleMarkers()
) |>
tagAppendAttributes(style = css("--bs-card-border-color" = "#1E1E1E"))
page_fillable(
card(
full_screen = TRUE,
card_header("Diamonds"),
sidebar_diamonds
),
card(
full_screen = TRUE,
card_header("Earthquakes"),
sidebar_quakes
)
)
# https://shiny.posit.co/blog/posts/bslib-dashboards/#accordions
library(bslib)
library(bsicons)
library(crosstalk)
library(plotly)
dat <- SharedData$new(dplyr::sample_n(diamonds, 1000))
accordion_filters <- accordion(
accordion_panel(
"Dropdowns", icon = bs_icon("menu-app"),
filter_select("cut", "Cut", dat, ~cut),
filter_select("color", "Color", dat, ~color),
filter_select("clarity", "Clarity", dat, ~clarity)
),
accordion_panel(
"Numerical", icon = bs_icon("sliders"),
filter_slider("depth", "Depth", dat, ~depth, ticks = FALSE),
filter_slider("table", "Table", dat, ~table, ticks = FALSE)
)
)
page_fillable(
card(
card_header("Groups of diamond filters"),
layout_sidebar(
sidebar = sidebar(bg = "white", accordion_filters),
plot_ly(dat) |> add_histogram(x = ~price)
)
)
)

Explore {bslib} v0.5.0

Use these example apps to explore the new features in {bslib} version 0.5.0. Try all of these apps on Posit Cloud without having to install anything! Or copy them to run locally.

Read about the release

Read all about the release in our post, Towards easy, delightful, and customizable Shiny dashboards with {bslib}.

Or head over to https://pkgs.rstudio.com/bslib to dive into more detailed articles!

About this project

Each numbered script corresponds to an example presented in the release blog post:

  1. 01-hello-dashboards.R: New dashboard-focused components in {bslib}.

  2. 02-themable-dashboards.R: Dashboards with {bslib} are fully themeable, and in real-time!

  3. 03-layout-tooling.R: Meet layout_columns(), a new interface to Bootstrap's 12-column grid.

  4. 04-card-level-sidebars.R: Use localized sidebars in cards for better user interfaces.

  5. 05-accordions.R: Group inputs and save space with the accordion component.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment