Tables and plots

Lesson 6 — R Shiny

Lesson 6 of 11 Intermediate ~90 min

Learning objectives

  • Build interactive tables with DT and reactable, including formatting
  • Capture and respond to table selection and filtering
  • Render ggplot2 plots that look right in a browser
  • Use click, hover and brush events to drive other outputs
  • Add interactivity with plotly and know its trade-offs
  • Link tables and plots into a coherent exploration workflow

Tables

DT

The workhorse. A JavaScript DataTables wrapper with good Shiny integration.

library(DT)

output$table <- renderDT({
  datatable(
    filtered(),
    rownames   = FALSE,
    filter     = "top",              # per-column filter boxes
    selection  = list(mode = "single", target = "row"),
    extensions = c("Buttons", "FixedHeader"),
    options = list(
      pageLength   = 25,
      lengthMenu   = c(10, 25, 50, 100),
      scrollX      = TRUE,
      fixedHeader  = TRUE,
      dom          = "Blfrtip",
      buttons      = list(
        list(extend = "csv",   text = "CSV",   filename = "adsl_export"),
        list(extend = "excel", text = "Excel", filename = "adsl_export")
      ),
      columnDefs = list(
        list(className = "dt-center", targets = c(2, 3)),
        list(visible = FALSE, targets = 0)
      )
    )
  ) |>
    formatRound(c("AVAL", "CHG", "PCHG"), digits = 2) |>
    formatPercentage("PCT", digits = 1) |>
    formatDate("ADT", method = "toLocaleDateString") |>
    formatStyle("CHG",
      color = styleInterval(0, c("#a32e46", "#1f7a52")),
      fontWeight = "bold") |>
    formatStyle("AVAL",
      background = styleColorBar(range(filtered()$AVAL, na.rm = TRUE), "#dff2f4"),
      backgroundSize = "98% 88%",
      backgroundRepeat = "no-repeat",
      backgroundPosition = "center")
})

The dom string controls which DataTables elements appear and in what order: B buttons, l length menu, f filter, r processing, t table, i info, p pagination.

Reacting to the table

DT exposes several inputs automatically, named after the output ID:

input$table_rows_selected      # integer indices of selected rows
input$table_rows_all           # indices after filtering, all pages
input$table_rows_current       # indices on the current page
input$table_cell_clicked       # list(row, col, value)
input$table_search             # global search string
input$table_state              # full state, for bookmarking
selected_subject <- reactive({
  idx <- input$table_rows_selected
  if (is.null(idx)) return(NULL)
  filtered()[idx, ]
})

output$detail <- renderUI({
  s <- selected_subject()
  validate(need(!is.null(s), "Select a subject to see their details."))
  tagList(
    h4(s$USUBJID),
    tags$dl(
      tags$dt("Age"),  tags$dd(s$AGE),
      tags$dt("Sex"),  tags$dd(s$SEX),
      tags$dt("Arm"),  tags$dd(s$TRT01P)
    )
  )
})

# Download exactly what the user is looking at
output$download <- downloadHandler(
  filename = function() paste0("filtered_", Sys.Date(), ".csv"),
  content  = function(file) {
    readr::write_csv(filtered()[input$table_rows_all, ], file)
  }
)

That last pattern — downloading rows_all rather than the whole dataset — matches what the user expects when they have typed into the column filters.

Updating without redrawing

Redrawing a large table loses the user’s scroll position, page and filters:

proxy <- dataTableProxy("table")

observeEvent(input$refresh, {
  replaceData(proxy, new_data(), resetPaging = FALSE, rownames = FALSE)
})

observeEvent(input$clear_selection, {
  selectRows(proxy, NULL)
})

observeEvent(input$goto, {
  selectPage(proxy, ceiling(input$goto / 25))
})

Editable tables

output$table <- renderDT({
  datatable(values(), editable = list(target = "cell",
                                      disable = list(columns = c(0, 1))))
})

observeEvent(input$table_cell_edit, {
  info <- input$table_cell_edit
  d <- values()
  d[info$row, info$col + 1] <- DT::coerceValue(info$value, d[info$row, info$col + 1])
  values(d)
})

coerceValue() converts the edited string back to the column’s type and warns if it cannot. Editable tables need careful validation — an edit that silently becomes NA is worse than a rejected edit.

reactable

A newer alternative with a more R-native API, better nested/grouped display and built-in sparklines.

library(reactable)

output$table <- renderReactable({
  reactable(
    filtered(),
    groupBy    = "TRT01P",
    searchable = TRUE,
    filterable = TRUE,
    defaultPageSize = 20,
    selection  = "single",
    onClick    = "select",
    highlight  = TRUE,
    striped    = TRUE,
    columns = list(
      USUBJID = colDef(name = "Subject", sticky = "left", minWidth = 140),
      AGE     = colDef(name = "Age", format = colFormat(digits = 0),
                       aggregate = "mean"),
      CHG     = colDef(
        name  = "Change",
        style = function(value) {
          list(color = if (value < 0) "#a32e46" else "#1f7a52",
               fontWeight = "bold")
        },
        format = colFormat(digits = 2)
      ),
      SAFFL   = colDef(name = "Safety", cell = function(v) {
        if (v == "Y") "✓" else "–"
      })
    )
  )
})

selected <- reactive(getReactableState("table", "selected"))
DT reactable
Maturity Very mature, huge install base Newer, actively developed
API DataTables options (JS-flavoured) R functions, more discoverable
Grouping / nesting Awkward Excellent
Custom cell rendering JS callbacks R functions
Export buttons Built in (extensions) Roll your own
Very large data Server-side processing Client-side only

Use DT when you need server-side processing for hundreds of thousands of rows, or the export buttons. Use reactable when the display logic is complex.

Plots

renderPlot

output$plot <- renderPlot({
  validate(need(nrow(filtered()) > 0, "No data to plot."))

  ggplot(filtered(), aes(AVISITN, AVAL, colour = TRT01P, group = USUBJID)) +
    geom_line(alpha = 0.25) +
    stat_summary(aes(group = TRT01P), fun = mean, geom = "line", linewidth = 1.2) +
    scale_colour_manual(values = c("Placebo" = "#7a8698",
                                   "Drug A"  = "#16355e",
                                   "Drug B"  = "#0a8f9e")) +
    labs(x = "Visit (weeks)", y = "Value", colour = "Treatment") +
    theme_minimal(base_size = 13)
}, res = 96)

res = 96 matches the browser’s pixel density, so text in the plot is the size you expect. Without it, everything is noticeably too small. Set it on every renderPlot().

Sizing:

plotOutput("plot", height = "500px")
plotOutput("plot", height = "auto")     # fills the container (needs a sized parent)

output$plot <- renderPlot({...},
  width  = function() session$clientData$output_plot_width,
  height = function() max(400, nrow(data()) * 20)   # taller with more rows
)

The height-from-data pattern matters for forest plots and AE plots, where a fixed height either wastes space or crushes the labels.

Interaction

ui <- plotOutput("plot",
  click    = "plot_click",
  dblclick = "plot_dblclick",
  hover    = hoverOpts("plot_hover", delay = 200, delayType = "debounce"),
  brush    = brushOpts("plot_brush", resetOnNew = TRUE, direction = "xy")
)
server <- function(input, output, session) {

  # Click: identify the nearest point
  clicked <- reactive({
    req(input$plot_click)
    nearPoints(filtered(), input$plot_click,
               xvar = "AVISITN", yvar = "AVAL",
               threshold = 10, maxpoints = 1)
  })

  # Brush: select a region
  brushed <- reactive({
    req(input$plot_brush)
    brushedPoints(filtered(), input$plot_brush)
  })

  # Double click to zoom, double click on empty space to reset
  ranges <- reactiveValues(x = NULL, y = NULL)

  observeEvent(input$plot_dblclick, {
    b <- input$plot_brush
    if (!is.null(b)) {
      ranges$x <- c(b$xmin, b$xmax)
      ranges$y <- c(b$ymin, b$ymax)
    } else {
      ranges$x <- NULL
      ranges$y <- NULL
    }
  })

  output$plot <- renderPlot({
    ggplot(filtered(), aes(AVISITN, AVAL)) +
      geom_point() +
      coord_cartesian(xlim = ranges$x, ylim = ranges$y, expand = FALSE)
  }, res = 96)

  # Hover tooltip
  output$hover_info <- renderUI({
    req(input$plot_hover)
    pt <- nearPoints(filtered(), input$plot_hover, threshold = 8, maxpoints = 1)
    req(nrow(pt) == 1)

    style <- sprintf(
      "position:absolute; left:%dpx; top:%dpx; background:rgba(255,255,255,0.95);
       border:1px solid #c9d1dc; border-radius:6px; padding:6px 10px;
       font-size:0.85rem; pointer-events:none; z-index:100;",
      round(input$plot_hover$coords_css$x) + 12,
      round(input$plot_hover$coords_css$y) + 12
    )
    tags$div(style = style,
      tags$strong(pt$USUBJID), tags$br(),
      sprintf("Week %d: %.2f", pt$AVISITN, pt$AVAL))
  })
}

The hover tooltip needs position: relative on the containing div for the absolute positioning to work.

plotly

Interactivity without writing the event handling:

library(plotly)

output$plot <- renderPlotly({
  p <- ggplot(filtered(), aes(AVISITN, AVAL, colour = TRT01P,
                              text = paste0("Subject: ", USUBJID,
                                            "<br>Value: ", round(AVAL, 2)))) +
    geom_point() +
    theme_minimal()

  ggplotly(p, tooltip = "text", source = "main") |>
    layout(dragmode = "select") |>
    config(displayModeBar = TRUE,
           modeBarButtonsToRemove = c("lasso2d", "autoScale2d"))
})

# Read plotly events
selected <- reactive({
  ev <- event_data("plotly_selected", source = "main")
  req(ev)
  filtered()[ev$pointNumber + 1, ]
})

clicked <- reactive({
  ev <- event_data("plotly_click", source = "main")
  req(ev)
  filtered()[ev$pointNumber + 1, ]
})
Warningplotly trade-offs

ggplotly() does not translate every ggplot2 feature — faceting with free scales, some geoms, and most theme() details are approximated or lost. It also sends all the data to the browser, so 100,000 points will make the page unresponsive.

For a plot that must exactly match a static output (a TLF, for instance), use renderPlot() with Shiny’s own click and brush handling. For an exploratory plot with a few thousand points, plotly saves a great deal of code.

Caching and performance

output$plot <- renderPlot({
  make_expensive_plot(input$param, input$arm)
}) |>
  bindCache(input$param, input$arm)

For very large point counts:

# Rasterise the point layer, keep axes and text as vectors
library(ggrastr)
ggplot(big_data, aes(x, y)) + rasterise(geom_point(), dpi = 150)

# Or aggregate rather than plotting every point
ggplot(big_data, aes(x, y)) + geom_hex(bins = 60)

Linked views

The pattern that makes a review app useful: selection in one view drives every other view.

server <- function(input, output, session) {

  # Single source of truth for the selection
  selected_subject <- reactiveVal(NULL)

  # Table selection
  observeEvent(input$table_rows_selected, {
    selected_subject(filtered()$USUBJID[input$table_rows_selected])
  })

  # Plot click
  observeEvent(input$plot_click, {
    pt <- nearPoints(filtered(), input$plot_click, maxpoints = 1)
    if (nrow(pt) == 1) selected_subject(pt$USUBJID)
  })

  # Clear
  observeEvent(input$clear, selected_subject(NULL))

  # Every view reads the same value
  output$plot <- renderPlot({
    p <- ggplot(filtered(), aes(AVISITN, AVAL, group = USUBJID)) +
      geom_line(colour = "grey80")

    if (!is.null(selected_subject())) {
      p <- p + geom_line(
        data = filter(filtered(), USUBJID == selected_subject()),
        colour = "#0a8f9e", linewidth = 1.4
      )
    }
    p + theme_minimal(base_size = 13)
  }, res = 96)

  output$detail <- renderUI({
    req(selected_subject())
    subject_card(filter(adsl, USUBJID == selected_subject()))
  })
}

Routing everything through one reactiveVal is what prevents the table and the plot disagreeing about what is selected.

Common mistakes

Mistake Symptom Fix
No res = 96 Plot text too small Add it
Re-rendering a big DT Loses page, filters, scroll replaceData() via proxy
Downloading the full dataset Ignores user’s filters Use input$table_rows_all
plotly with 100k points Browser hangs renderPlot() or aggregate
Table and plot each own the selection They disagree One reactiveVal
nearPoints() without xvar/yvar No match on transformed scales Name the variables
Fixed plot height for variable-length data Crushed or empty Compute height from nrow()

Exercise 6.1 — Table-driven detail view

Build an app with a DT of subjects. Selecting a row shows that subject’s lab values over time in a plot below, and clears cleanly when the selection is removed.

Show solution 
library(shiny); library(bslib); library(DT); library(dplyr); library(ggplot2)

ui <- page_fillable(
  title = "Subject lab review",
  card(
    card_header("Subjects"),
    DTOutput("subjects"), height = "45%"
  ),
  card(
    card_header(textOutput("plot_title", inline = TRUE)),
    plotOutput("labplot")
  )
)

server <- function(input, output, session) {

  adsl <- reactive(readRDS("data/adsl.rds"))
  adlb <- reactive(readRDS("data/adlb.rds"))

  output$subjects <- renderDT({
    datatable(
      adsl() |> select(USUBJID, TRT01P, AGE, SEX, SAFFL),
      rownames  = FALSE,
      selection = "single",
      filter    = "top",
      options   = list(pageLength = 8, scrollX = TRUE)
    )
  })

  selected_id <- reactive({
    idx <- input$subjects_rows_selected
    if (is.null(idx)) NULL else adsl()$USUBJID[idx]
  })

  subject_labs <- reactive({
    req(selected_id())
    adlb() |>
      filter(USUBJID == selected_id()) |>
      arrange(PARAMCD, AVISITN)
  })

  output$plot_title <- renderText({
    if (is.null(selected_id())) "Lab profile" else
      paste("Lab profile —", selected_id())
  })

  output$labplot <- renderPlot({
    validate(need(!is.null(selected_id()), "Select a subject above."))
    validate(need(nrow(subject_labs()) > 0,
                  paste("No lab records for", selected_id())))

    ggplot(subject_labs(), aes(AVISITN, AVAL)) +
      geom_line(colour = "#16355e") +
      geom_point(size = 2, colour = "#16355e") +
      geom_hline(aes(yintercept = ANRLO), linetype = "dashed",
                 colour = "#a32e46", na.rm = TRUE) +
      geom_hline(aes(yintercept = ANRHI), linetype = "dashed",
                 colour = "#a32e46", na.rm = TRUE) +
      facet_wrap(~ PARAM, scales = "free_y", ncol = 3) +
      labs(x = "Visit (weeks)", y = "Result") +
      theme_minimal(base_size = 12) +
      theme(strip.text = element_text(face = "bold"))
  }, res = 96)
}

The reference-range lines are what makes this a review tool rather than a demo — a lab value is only interpretable against its normal range. Note na.rm = TRUE on the geom_hline() calls: parameters without a defined range would otherwise emit warnings for every row.

The two-stage validate() distinguishes “nothing selected” from “selected but no data”, which are different situations for the reviewer.

Exercise 6.2 — Brush to filter

Build a scatter plot where brushing a region filters a table below to the brushed points, with a button to clear the brush. Show how many points are selected.

Show solution 
library(shiny); library(bslib); library(DT); library(dplyr); library(ggplot2)

ui <- page_fillable(
  card(
    card_header(
      class = "d-flex justify-content-between align-items-center",
      "Baseline vs change — drag to select",
      actionButton("clear", "Clear selection", class = "btn-sm btn-outline-secondary")
    ),
    plotOutput("scatter", brush = brushOpts("brush", resetOnNew = TRUE,
                                            fill = "#0a8f9e", opacity = 0.2)),
    height = "55%"
  ),
  card(
    card_header(textOutput("n_selected", inline = TRUE)),
    DTOutput("table")
  )
)

server <- function(input, output, session) {

  adlb <- reactive({
    readRDS("data/adlb.rds") |> filter(PARAMCD == "ALT", AVISITN == 12)
  })

  # Clearing: bump a counter that the selection reactive depends on
  cleared <- reactiveVal(0)
  observeEvent(input$clear, {
    session$resetBrush("brush")
    cleared(cleared() + 1)
  })

  selected <- reactive({
    cleared()                                # dependency so clearing re-runs this
    b <- input$brush
    if (is.null(b)) return(adlb()[0, ])      # empty, same columns
    brushedPoints(adlb(), b, xvar = "BASE", yvar = "CHG")
  })

  output$scatter <- renderPlot({
    p <- ggplot(adlb(), aes(BASE, CHG)) +
      geom_hline(yintercept = 0, colour = "grey70") +
      geom_point(colour = "grey65", size = 2)

    if (nrow(selected()) > 0) {
      p <- p + geom_point(data = selected(), colour = "#0a8f9e", size = 2.6)
    }

    p +
      labs(x = "Baseline ALT (U/L)", y = "Change from baseline (U/L)") +
      theme_minimal(base_size = 13)
  }, res = 96)

  output$n_selected <- renderText({
    if (nrow(selected()) == 0) {
      sprintf("All %d subjects (no selection)", nrow(adlb()))
    } else {
      sprintf("%d of %d subjects selected", nrow(selected()), nrow(adlb()))
    }
  })

  output$table <- renderDT({
    d <- if (nrow(selected()) > 0) selected() else adlb()
    datatable(
      d |> select(USUBJID, TRT01P, BASE, AVAL, CHG, PCHG),
      rownames = FALSE,
      options  = list(pageLength = 10, scrollX = TRUE)
    ) |>
      formatRound(c("BASE", "AVAL", "CHG", "PCHG"), 2)
  })
}

Two subtleties:

  • session$resetBrush() alone is not enough. It clears the brush in the browser, but if input$brush was already NULL (or the round trip is delayed) the reactive may not re-evaluate. The cleared() counter forces it.
  • Returning adlb()[0, ] rather than NULL when nothing is brushed keeps the return type stable, so nrow() always works and the downstream code needs no is.null() branches.
The “show everything when nothing is selected” behaviour is a deliberate usability choice — an empty table on load looks broken.

Recap

  • DT exposes _rows_selected, _rows_all and _cell_clicked automatically
  • Download input$table_rows_all to respect the user’s column filters
  • Use dataTableProxy() + replaceData() instead of re-rendering large tables
  • res = 96 on every renderPlot()
  • nearPoints() and brushedPoints() for click and brush; name xvar/yvar
  • plotly is fast to write but does not scale past a few thousand points
  • Route every selection through one reactiveVal so views cannot disagree

Next: File uploads and downloads.

Back to top