The hardware and bandwidth for this mirror is donated by dogado GmbH, the Webhosting and Full Service-Cloud Provider. Check out our Wordpress Tutorial.
If you wish to report a bug, or if you are interested in having us mirror your free-software or open-source project, please feel free to contact us at mirror[@]dogado.de.

Shiny App Example: LMS Explorer

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:

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

These binaries (installable software) and packages are in development.
They may not be fully stable and should be used with caution. We make no claims about them.
Health stats visible at Monitor.