Skip to contents

Shiny App Example: LMS Explorer

Source: vignettes/shiny-app.Rmd
shiny-app.Rmd

This article provides a complete Shiny application that uses brightspaceR to build an interactive LMS analytics dashboard. The app lets users explore enrollments, grades, and course activity through point-and-click filters.

Prerequisites 

install.packages(c("shiny", "bslib", "DT"))
# brightspaceR must be installed and authenticated:
# bs_auth()

The complete app

Save the code below as app.R and run with shiny::runApp().

library(shiny)
library(bslib)
library(DT)
library(dplyr)
library(ggplot2)
library(lubridate)
library(brightspaceR)

# ── Data loading ──────────────────────────────────────────────────────────────
# Load once at startup. In production, wrap in a reactive timer to refresh
# periodically.
message("Loading Brightspace data...")
users        <- bs_get_dataset("Users")
enrollments  <- bs_get_dataset("User Enrollments")
org_units    <- bs_get_dataset("Org Units")
roles        <- bs_get_dataset("Role Details")
grades       <- bs_get_dataset("Grade Results")
grade_objects <- bs_get_dataset("Grade Objects")

# Pre-join common combinations
enrollment_detail <- enrollments |>
  bs_join_enrollments_roles(roles) |>
  bs_join_enrollments_orgunits(org_units)

grade_detail <- grades |>
  bs_join_grades_objects(grade_objects)

message("Data loaded.")

# ── UI ────────────────────────────────────────────────────────────────────────
ui <- page_sidebar(
  title = "brightspaceR LMS Explorer",
  theme = bs_theme(
    preset = "shiny",
    primary = "#f59e0b",
    "navbar-bg" = "#1a1a2e"
  ),

  sidebar = sidebar(
    width = 280,
    title = "Filters",
    selectInput("role_filter", "Role",
      choices = c("All", sort(unique(enrollment_detail$role_name))),
      selected = "All"
    ),
    selectInput("course_filter", "Course",
      choices = c("All", sort(unique(
        org_units$name[org_units$type == "Course Offering"]
      ))),
      selected = "All"
    ),
    dateRangeInput("date_range", "Enrollment Date",
      start = Sys.Date() - 365,
      end = Sys.Date()
    ),
    hr(),
    actionButton("refresh", "Refresh Data", class = "btn-outline-primary btn-sm")
  ),

  # KPI cards
  layout_columns(
    col_widths = c(3, 3, 3, 3),
    value_box(
      title = "Total Users", value = textOutput("kpi_users"),
      showcase = icon("users"), theme = "primary"
    ),
    value_box(
      title = "Enrollments", value = textOutput("kpi_enrollments"),
      showcase = icon("graduation-cap"), theme = "info"
    ),
    value_box(
      title = "Courses", value = textOutput("kpi_courses"),
      showcase = icon("book"), theme = "success"
    ),
    value_box(
      title = "Avg Grade", value = textOutput("kpi_grade"),
      showcase = icon("chart-line"), theme = "warning"
    )
  ),

  # Charts row
  layout_columns(
    col_widths = c(6, 6),
    card(
      card_header("Enrollments by Role"),
      plotOutput("role_chart", height = "300px")
    ),
    card(
      card_header("Monthly Enrollment Trend"),
      plotOutput("trend_chart", height = "300px")
    )
  ),

  # Second charts row
  layout_columns(
    col_widths = c(6, 6),
    card(
      card_header("Grade Distribution"),
      plotOutput("grade_chart", height = "300px")
    ),
    card(
      card_header("Top 10 Courses"),
      plotOutput("course_chart", height = "300px")
    )
  ),

  # Data table
  card(
    card_header("Enrollment Detail"),
    DTOutput("enrollment_table")
  )
)

# ── Server ────────────────────────────────────────────────────────────────────
server <- function(input, output, session) {

  # Filtered enrollment data
  filtered_enrollments <- reactive({
    df <- enrollment_detail

    if (input$role_filter != "All") {
      df <- df |> filter(role_name == input$role_filter)
    }
    if (input$course_filter != "All") {
      df <- df |> filter(name == input$course_filter)
    }
    if (!is.null(input$date_range)) {
      df <- df |> filter(
        as.Date(enrollment_date) >= input$date_range[1],
        as.Date(enrollment_date) <= input$date_range[2]
      )
    }
    df
  })

  # Filtered grades
  filtered_grades <- reactive({
    df <- grade_detail |>
      filter(!is.na(points_numerator), points_numerator >= 0)

    if (input$course_filter != "All") {
      course_ids <- org_units |>
        filter(name == input$course_filter) |>
        pull(org_unit_id)
      df <- df |> filter(org_unit_id %in% course_ids)
    }
    df
  })

  # ── KPIs ──
  output$kpi_users <- renderText({
    format(nrow(users), big.mark = ",")
  })

  output$kpi_enrollments <- renderText({
    format(nrow(filtered_enrollments()), big.mark = ",")
  })

  output$kpi_courses <- renderText({
    n <- filtered_enrollments() |>
      filter(type == "Course Offering") |>
      distinct(org_unit_id) |>
      nrow()
    format(n, big.mark = ",")
  })

  output$kpi_grade <- renderText({
    g <- filtered_grades()
    if (nrow(g) == 0) return("--")
    paste0(round(mean(g$points_numerator, na.rm = TRUE), 1), "%")
  })

  # ── Charts ──
  chart_theme <- theme_minimal(base_size = 13) +
    theme(
      plot.background = element_rect(fill = "white", colour = NA),
      panel.grid.minor = element_blank()
    )

  output$role_chart <- renderPlot({
    filtered_enrollments() |>
      count(role_name, sort = TRUE) |>
      head(8) |>
      ggplot(aes(x = reorder(role_name, n), y = n, fill = role_name)) +
      geom_col(show.legend = FALSE) +
      coord_flip() +
      scale_fill_brewer(palette = "Set2") +
      labs(x = NULL, y = "Count") +
      chart_theme
  })

  output$trend_chart <- renderPlot({
    filtered_enrollments() |>
      mutate(month = floor_date(as.Date(enrollment_date), "month")) |>
      count(month) |>
      ggplot(aes(x = month, y = n)) +
      geom_line(colour = "#818cf8", linewidth = 1) +
      geom_point(colour = "#818cf8", size = 2) +
      scale_x_date(date_labels = "%b %Y") +
      labs(x = NULL, y = "New Enrollments") +
      chart_theme
  })

  output$grade_chart <- renderPlot({
    filtered_grades() |>
      ggplot(aes(x = points_numerator)) +
      geom_histogram(binwidth = 5, fill = "#38bdf8", colour = "white") +
      labs(x = "Grade (%)", y = "Count") +
      chart_theme
  })

  output$course_chart <- renderPlot({
    filtered_enrollments() |>
      filter(type == "Course Offering") |>
      count(name, sort = TRUE) |>
      head(10) |>
      ggplot(aes(x = reorder(name, n), y = n)) +
      geom_col(fill = "#f59e0b") +
      coord_flip() +
      labs(x = NULL, y = "Enrollments") +
      chart_theme
  })

  # ── Data table ──
  output$enrollment_table <- renderDT({
    filtered_enrollments() |>
      select(any_of(c(
        "user_id", "role_name", "name", "type",
        "enrollment_date"
      ))) |>
      head(500)
  }, options = list(pageLength = 15, scrollX = TRUE))

  # ── Refresh button ──
  observeEvent(input$refresh, {
    showNotification("Refreshing data...", type = "message")
    # In production, re-fetch from Brightspace here
  })
}

shinyApp(ui, server)

Running the app 

# From the directory containing app.R:
shiny::runApp()

# Or run from anywhere:
shiny::runApp("/path/to/app.R")

How it works

Data loading

The app loads six BDS datasets at startup and pre-joins them into two working tables:

  • enrollment_detail: enrollments joined with roles and org units – gives each enrollment row a human-readable role name and course name.
  • grade_detail: grade results joined with grade objects – adds grade item names and max points to each score.

This front-loads the expensive I/O so the reactive filters are fast.

Filtering

Three filters (role, course, date range) drive all charts and the data table through a single filtered_enrollments() reactive. Changing any filter instantly updates the full dashboard.

Chart rendering

The app uses ggplot2 for charts. For a production deployment with heavier interactivity needs (tooltips, zoom, click events), swap plotOutput for plotly::plotlyOutput and wrap ggplots in plotly::ggplotly():

# In UI:
plotly::plotlyOutput("role_chart", height = "300px")

# In server:
output$role_chart <- plotly::renderPlotly({
  p <- ggplot(...) + geom_col(...)
  plotly::ggplotly(p)
})

Extending the app

Adding authentication

For multi-user deployments, wrap the data loading in a reactive that authenticates per session:

# In server:
bs_data <- reactive({
  # Each user needs their own token
  bs_auth_token(session$userData$token)
  list(
    users = bs_get_dataset("Users"),
    enrollments = bs_get_dataset("User Enrollments")
  )
})

Adding a download button

Let users export the filtered data as CSV:

# In UI, inside the enrollment_table card:
downloadButton("download_csv", "Export CSV")

# In server:
output$download_csv <- downloadHandler(
  filename = function() {
    paste0("enrollments_", Sys.Date(), ".csv")
  },
  content = function(file) {
    readr::write_csv(filtered_enrollments(), file)
  }
)

Scheduled data refresh

For always-fresh data, use reactiveTimer() to periodically re-fetch:

# Re-fetch every 30 minutes
auto_refresh <- reactiveTimer(30 * 60 * 1000)

live_enrollments <- reactive({
  auto_refresh()
  bs_get_dataset("User Enrollments")
})

Deploying to Posit Connect / shinyapps.io

  1. Store credentials as environment variables on the server
  2. Use bs_auth_refresh() with a long-lived refresh token instead of the interactive browser flow
  3. Pin datasets with the pins package for faster startup:
# Write once:
board <- pins::board_connect()
pins::pin_write(board, bs_get_dataset("Users"), "brightspace_users")

# Read in app:
users <- pins::pin_read(board, "brightspace_users")