Example apps using bslib v0.5.0

01-hello-dashboards.R

# 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)

02-themable-dashboards.R

# 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)

03-layout-tooling.R

# 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)

04-card-level-sidebars.R

# 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
  )
)

05-accordions.R

# 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)
    )
  )
)

README.md

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.