Filling Layouts

Fillabilly who?

Outline

Filling Layouts

Heights in nested containers

Block elements, at least by default on the web, take up full width but are lazy about their height. In general, a block element’s height is driven by the height of its contents.

The example below uses basic Boostrap markup for a card. What happens when you…

  • Resize the width of the page?
  • Adjust the height of the leaflet output?
  • Add additional text to the card using lorem::ipsum(2, 1:2)?
  • Give the card a fixed height?
#| standalone: true
#| components: [editor, viewer]

library(shiny)
library(bslib)
library(leaflet)
library(collegeScorecard)

lehigh <- school[school$name == "Lehigh University", ]

card_basic <- function(..., class = NULL, height = NULL) {
  div(
    class = "card", class = class,
    style = htmltools::css(height = height),
    div(
      class = "card-body",
      ...
    )
  )
}

ui <- page_fixed(
  card_basic(
    class = "text-bg-dark",
    leafletOutput("map_lehigh", height = "300px")
  )
)

server <- function(input, output, session) {
  output$map_lehigh <- renderLeaflet({
    leaflet() |>
      addTiles() |>
      setView(lng = lehigh$longitude, lat = lehigh$latitude, zoom = 13) |>
      addMarkers(lng = lehigh$longitude, lat = lehigh$latitude, popup = lehigh$name)
  })
}

shinyApp(ui, server)

Filling layouts

bslib introduced the concept of filling layouts to solve a common problem in Shiny apps, especially dashboards.

How can an output or layout take up all of the space available to it?

This flips the arrows of causality. Instead of letting the plot or map drive the height of its containers, we want the map to take up whatever space it can.

In the example below, replace card_basic() with bslib::card(). What happens when you…

  • Change the height of the card?
  • Add text to the card with lorem::ipsum(2, 1:2)?
  • Make the card very tall or very short (with and without the extra text)?
  • Replace page_fixed() with page_fillable()? (Hint: make sure the viewer is wide enough.)
#| standalone: true
#| components: [editor, viewer]

library(shiny)
library(bslib)
library(leaflet)
library(collegeScorecard)

lehigh <- school[school$name == "Lehigh University", ]

card_basic <- function(..., class = NULL, height = NULL) {
  div(
    class = "card", class = class,
    style = htmltools::css(height = height),
    div(
      class = "card-body",
      ...
    )
  )
}

ui <- page_fixed(
  card_basic(
    class = "text-bg-dark",
    height = "300px",
    leafletOutput("map_lehigh")
  )
)

server <- function(input, output, session) {
  output$map_lehigh <- renderLeaflet({
    leaflet() |>
      addTiles() |>
      setView(lng = lehigh$longitude, lat = lehigh$latitude, zoom = 13) |>
      addMarkers(lng = lehigh$longitude, lat = lehigh$latitude, popup = lehigh$name)
  })
}

shinyApp(ui, server)

Breaking fillability

Fillable layouts are really two elements working together:

  1. A fillable container creates a space for filling.

  2. A fill item can fill the container.

These two elements work together. Filling layouts are only activated when fillable container is the parent ⇆ of a fill item child.

To break fillability, you have three options:

  1. Set fill = FALSE on the item.

  2. Set fillable = FALSE on the parent.

  3. Break the parent ⇆ child relationship.

By default, bslib tends to break fillability on mobile devices to switch to a flow layout. Look for fillable_mobile and set it to TRUE when you want fillable layouts on mobile screens.

The example below features a card with text, a button, and a map. Make sure that the viewer pane is wide enough to activate the filling layout.

  • Why is the button full width? Do you want that?
  • How can we make the contents of the entire card scrollable?
  • How can we make the map taller?
#| standalone: true
#| components: [editor, viewer]
#| viewerHeight: 500px
library(shiny)
library(bslib)
library(leaflet)
library(collegeScorecard)
source("lehigh.R")

lehigh <- school[school$name == "Lehigh University", ]

ui <- page_fillable(
  card(
    class = "text-bg-light",
    card_body(
      h3("Lehigh University"),
      p_lehigh_1, p_lehigh_2, p_lehigh_3,
      actionButton("visit", "Visit School"),
      leafletOutput("map_lehigh"),
    )
  )
)

server <- function(input, output, session) {
  output$map_lehigh <- renderLeaflet({
    leaflet() |>
      addTiles() |>
      setView(lng = lehigh$longitude, lat = lehigh$latitude, zoom = 13) |>
      addMarkers(lng = lehigh$longitude, lat = lehigh$latitude, popup = lehigh$name)
  })
}

shinyApp(ui, server)



## file: lehigh.R
p_lehigh_1 <- p(
  "Lehigh University, founded in 1865, is a private research institution located in Bethlehem, Pennsylvania.",
  "With around 5,000 undergraduate students and 2,000 graduate students, it offers over 100 majors across its four colleges, with a student-faculty ratio of 9:1."
)

p_lehigh_2 <- p(
  "Notable academic programs include engineering, business, and the arts and sciences.",
  "Lehigh's engineering programs, particularly in mechanical and electrical engineering, are highly regarded, and the university has a strong reputation for innovation and entrepreneurship.",
  "Additionally, its College of Business offers nationally recognized programs, preparing students for success in various fields of business and management."
)

p_lehigh_3 <- p(
  "The university emphasizes a hands-on approach to education, with opportunities for experiential learning and research.",
  "Lehigh's strong alumni network and high post-graduation employment rates make it an attractive option for those seeking a diverse and career-oriented academic experience."
)

Fillable Pages

There are three pages that provide page-level filling behavior and are useful for dashboards:

page_fillable()

A screen-filling page layout. Try settings these arguments:

  • padding
  • gap
  • fillable_mobile
  • title
#| standalone: true
#| components: [editor, viewer]
library(shiny)
library(bslib)

ui <- page_fillable(
  layout_columns(
    card(class = "text-bg-primary", "A"),
    card(class = "text-bg-secondary", "B"),
  ),
  card(class = "bg-teal", "C"),
  card(class = "bg-orange text-light", "D")
)

shinyApp(ui, \(...) { })

page_sidebar()

A dashboard layout with full-screen header and sidebar. In addition to the arguments above, try setting these arguments:

  • sidebar
  • bg
  • fg
#| standalone: true
#| components: [editor, viewer]
library(shiny)
library(bslib)

ui <- page_sidebar(
  sidebar = sidebar(title = "Sidebar"),
  layout_columns(
    card(class = "text-bg-primary", "A"),
    card(class = "text-bg-secondary", "B"),
  ),
  card(class = "bg-teal", "C"),
  card(class = "bg-orange text-light", "D")
)

shinyApp(ui, \(...) { })

page_navbar()

Another dashboard layout with a top-level navigation bar. Pairs with nav_panel() elements. Try setting these arguments:

  • fillable
  • sidebar
  • position
  • underline

Also add a nav_spacer() and a nav_item().

#| standalone: true
#| components: [editor, viewer]
library(shiny)
library(bslib)

ui <- page_navbar(
  nav_panel(
    "One",
    layout_columns(
      card(class = "text-bg-primary", "A"),
      card(class = "text-bg-secondary", "B"),
    ),
    card(class = "bg-teal", "C")
  ),
  nav_panel(
    "Two",
    card(class = "bg-orange text-light", "D")
  )
)

shinyApp(ui, \(...) { })

🧑‍💻 Your Turn

exercises/05_app.R

exercises/05_app.R
library(shiny)
library(bslib)
library(leaflet)
library(plotly)
library(tidyverse)
library(collegeScorecard)


# Data --------------------------------------------------------------------
school_1k <-
  scorecard |>
  slice_max(academic_year, by = id, n = 1) |>
  filter(n_undergrads > 1000) |>
  semi_join(school, y = _, by = "id") |>
  filter(!is.na(latitude))

# UI ----------------------------------------------------------------------
ui <- page_sidebar(
  title = "05 - Fillable Layouts",
  sidebar = sidebar(
    selectInput("name", "School Name", NULL),
    actionButton("random_school", "Random School", fontawesome::fa_i("shuffle"))
  ),
  card(
    card_header("Undergraduate Students by Academic Year"),
    plotlyOutput("plot_n_undergrads")
  ),
  card(
    card_header("Average Yearly Cost"),
    plotlyOutput("plot_cost_avg")
  ),
  card(
    card_header("Completion Rate"),
    plotlyOutput("plot_rate_completion")
  ),
  card(
    card_header("Cost by Income"),
    plotlyOutput("plot_cost_by_income")
  ),
  card(
    class = "text-bg-secondary",
    card_header("School Location"),
    card_body(
      padding = 0,
      leafletOutput("map_school")
    )
  ),
  card(
    card_header("School Information"),
    tableOutput("table_school")
  )
)

# Server ------------------------------------------------------------------
server <- function(input, output, session) {
  # School Selection ----
  observe({
    updateSelectizeInput(session, "name", choices = school_1k$name, server = TRUE)
  })

  observeEvent(input$random_school, {
    updateSelectizeInput(session, "name", choices = school_1k$name, selected = sample(school_1k$name, 1), server = TRUE)
  })

  r_scorecard <- eventReactive(input$name, {
    scorecard |>
      inner_join(school_1k |> filter(name == input$name), by = "id") |>
      mutate(
        year = sub("-.+", "", academic_year),
        year = as.integer(year)
      )
  })

  validate_not_all_missing <- function(x, column) {
    validate(need(any(!is.na(x[[column]])), "No data"))
  }

  # Plot: Undergrad Students by Academic Year ----
  output$plot_n_undergrads <- renderPlotly({
    validate_not_all_missing(r_scorecard(), "n_undergrads")
    r_scorecard() |>
      plot_ly(
        x = ~year,
        y = ~n_undergrads,
        type = "scatter",
        mode = "lines+markers",
        hoverinfo = "text",
        text = ~ paste0(
          "Undergrad Students: ",
          scales::number(n_undergrads, big.mark = ",")
        )
      ) |>
      layout(
        xaxis = list(title = "Year"),
        yaxis = list(title = "")
      ) |>
      config(displayModeBar = FALSE)
  })

  # Plot: Average Yearly Cost ----
  output$plot_cost_avg <- renderPlotly({
    validate_not_all_missing(r_scorecard(), "cost_avg")
    r_scorecard() |>
      plot_ly(
        x = ~year,
        y = ~cost_avg,
        type = "scatter",
        mode = "lines+markers",
        hoverinfo = "text",
        text = ~ paste0(
          "Average Yearly Cost: ",
          scales::dollar(cost_avg)
        )
      ) |>
      layout(
        xaxis = list(title = "Year"),
        yaxis = list(title = "")
      ) |>
        config(displayModeBar = FALSE)
  })

  output$plot_rate_completion <- renderPlotly({
    validate_not_all_missing(r_scorecard(), "rate_completion")

    r_scorecard() |>
      plot_ly(
        x = ~year,
        y = ~rate_completion,
        type = "scatter",
        mode = "lines+markers",
        hoverinfo = "text",
        text = ~ paste0(
          "Completion Rate: ",
          scales::percent(rate_completion)
        )
      ) |>
      layout(
        xaxis = list(title = "Year"),
        yaxis = list(title = "")
      ) |>
      config(displayModeBar = FALSE)
  })

  # Plot: Cost by income ----
  output$plot_cost_by_income <- renderPlotly({
    income_level <- c(
      "0_30k" = "$0 - $30k",
      "30_48k" = "$30k - $48k",
      "48_75k" = "$48k - $75k",
      "75_110k" = "$75k - $110k",
      "110k_plus" = "$110k+"
    )

    r_scorecard() |>
      slice_max(academic_year, n = 1) |>
      select(starts_with("cost_avg_income")) |>
      pivot_longer(everything(), names_prefix = "cost_avg_income_") |>
      mutate(name = factor(name, names(income_level), income_level)) |>
      plot_ly(
        x = ~value,
        y = ~name,
        type = "bar",
        hoverinfo = "text",
        textposition = "none",
        text = ~ paste0(
          "Income Level: ",
          name,
          "<br>",
          "Average Cost: ",
          scales::dollar(value)
        )
      ) |>
      layout(
        xaxis = list(title = "Average Yearly Cost"),
        yaxis = list(title = "Income Level")
      ) |>
      plotly::config(displayModeBar = FALSE)
  })

  # Map: School location ----
  output$map_school <- renderLeaflet({
    validate(need(r_scorecard()$latitude, "No location data"))

    r_scorecard() |>
      leaflet() |>
      addTiles() |>
      addMarkers(
        lng = ~longitude,
        lat = ~latitude,
        popup = ~name
      )
  })

  # Table: Selected School Information ----
  output$table_school <- renderTable({
    req(input$name)

    school_1k |>
      filter(name == input$name) |>
      select(-id) |>
      mutate(
        across(starts_with("rate"), scales::percent),
        across(where(is.logical), \(x) ifelse(x, "Yes", "No")),
        across(where(is.numeric), \(x) scales::number(x, accuracy = 0.01))
      ) |>
      pivot_longer(everything(), names_to = "Variable", values_to = "Value") |>
      mutate(
        Variable = str_replace_all(Variable, "_", " "),
        Variable = str_to_title(Variable)
      ) |>
      filter(!is.na(Value))
  })
}

shinyApp(ui, server)

The app in exercises/05_app.R uses a lot of plots and components, some of which are familiar but none of which have enough space in the current layout.

Your task for this exercise is to make sure the plots are readable and usable at all screen sizes. Consider the following options:

  • Setting a minimum height via min_height
  • Using layout_columns() or layout_column_wrap()
  • Using page_navbar() or another page layout
  • Breaking fillability as needed