Dynamic user interfaces

Lesson 5 — R Shiny

Lesson 5 of 11 Intermediate ~75 min

Learning objectives

Choose between update*, conditionalPanel, renderUI and insertUI
Generate UI that depends on the data
Add and remove UI elements at runtime without leaking observers
Show and hide elements efficiently with shinyjs
Avoid the performance and state problems dynamic UI creates

Four techniques, in order of preference

Technique	Cost	Use when
`update*Input()`	Cheapest	Changing choices, values or labels of an existing input
`conditionalPanel()`	Cheap (client-side)	Showing/hiding based on a simple condition
`shinyjs::toggle()`	Cheap	Showing/hiding based on a server-side condition
`renderUI()`	Expensive	The structure genuinely depends on data
`insertUI()` / `removeUI()`	Expensive	Adding an unknown number of elements

The rule: prefer the cheapest technique that works. Every renderUI() call destroys and recreates DOM elements, which loses focus, scroll position and any input state that was not explicitly preserved.

`update*Input()` — change, do not rebuild

observeEvent(input$domain, {
  updateSelectInput(session, "variable",
                    choices  = names(get_domain(input$domain)),
                    selected = character(0))
})

observeEvent(input$running, {
  updateActionButton(session, "run",
                     label = if (input$running) "Stop" else "Run",
                     icon  = icon(if (input$running) "stop" else "play"))
})

If the type of control stays the same and only its contents change, this is always the right answer.

`conditionalPanel()` — client-side visibility

The condition is JavaScript, evaluated in the browser. No server round trip.

ui <- fluidPage(
  radioButtons("plot_type", "Plot type", c("Scatter", "Histogram", "Box")),

  conditionalPanel(
    condition = "input.plot_type == 'Histogram'",
    sliderInput("bins", "Number of bins", 5, 50, 20)
  ),

  conditionalPanel(
    condition = "input.plot_type == 'Scatter'",
    selectInput("x", "X variable", numeric_cols),
    selectInput("y", "Y variable", numeric_cols),
    checkboxInput("smooth", "Add trend line", FALSE)
  ),

  # Multiple conditions, JavaScript syntax
  conditionalPanel(
    condition = "input.plot_type != 'Box' && input.advanced == true",
    sliderInput("alpha", "Point transparency", 0, 1, 0.7)
  )
)

Note the JavaScript conventions: input.x not input$x, == not =, && and ||, true/false lower case.

Inside a module, the condition needs the namespace:

mod_plot_ui <- function(id) {
  ns <- NS(id)
  tagList(
    radioButtons(ns("type"), "Type", c("Scatter", "Histogram")),
    conditionalPanel(
      condition = "input.type == 'Histogram'",
      ns = ns,                                  # <- required
      sliderInput(ns("bins"), "Bins", 5, 50, 20)
    )
  )
}

Forgetting ns = ns there is a silent failure: the panel simply never shows.

Hidden is not absent

A conditionalPanel that is hidden still exists in the DOM, and its inputs still have values that reach the server. This is a security consideration if you use it to hide privileged controls — hide the capability on the server, not just the control in the browser.

`shinyjs` — server-side show/hide

library(shinyjs)

ui <- fluidPage(
  useShinyjs(),                         # required
  actionButton("run", "Run"),
  hidden(div(id = "results_panel", plotOutput("plot")))
)

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

  observeEvent(input$run, {
    show("results_panel", anim = TRUE)
    disable("run")
    ...
    enable("run")
  })

  observe({
    toggleState("download", condition = nrow(filtered()) > 0)
  })
}

Useful shinyjs functions:

show(id); hide(id); toggle(id)
enable(id); disable(id); toggleState(id, condition)
addClass(id, "text-danger"); removeClass(id, "text-danger")
reset("form")                     # reset all inputs in a container
delay(1000, show("panel"))
runjs("window.scrollTo(0, 0);")
html(id = "status", html = "<b>Complete</b>")
click("run")                      # programmatically click a button

reset() is worth remembering: resetting a form of fifteen inputs by hand is fifteen update* calls.

`renderUI()` — structure from data

When the number or type of controls depends on data:

ui <- fluidPage(
  fileInput("file", "Upload dataset"),
  uiOutput("var_selectors"),
  plotOutput("plot")
)

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

  data <- reactive({
    req(input$file)
    readr::read_csv(input$file$datapath, show_col_types = FALSE)
  })

  output$var_selectors <- renderUI({
    req(data())
    num_cols <- names(data())[sapply(data(), is.numeric)]
    cat_cols <- names(data())[sapply(data(), \(x) is.character(x) || is.factor(x))]

    tagList(
      selectInput("x", "X variable", choices = num_cols),
      selectInput("y", "Y variable", choices = num_cols,
                  selected = num_cols[min(2, length(num_cols))]),
      if (length(cat_cols) > 0) {
        selectInput("colour", "Colour by", choices = c("None", cat_cols))
      }
    )
  })

  output$plot <- renderPlot({
    req(input$x, input$y)
    p <- ggplot(data(), aes(.data[[input$x]], .data[[input$y]])) + geom_point()
    if (!is.null(input$colour) && input$colour != "None") {
      p <- p + aes(colour = .data[[input$colour]])
    }
    p
  })
}

Two things to notice:

req(input$x, input$y) in the consumer. Inputs created by renderUI() are NULL until the browser has created them and sent their values back — which is at least one round trip after renderUI() runs.
The if inside tagList() returns NULL when false, and NULL elements are dropped. This is the idiomatic way to include UI conditionally.

Generating a variable number of controls

output$filters <- renderUI({
  req(data())

  lapply(names(data()), function(col) {
    if (is.numeric(data()[[col]])) {
      sliderInput(paste0("f_", col), col,
                  min   = min(data()[[col]], na.rm = TRUE),
                  max   = max(data()[[col]], na.rm = TRUE),
                  value = range(data()[[col]], na.rm = TRUE))
    } else {
      selectInput(paste0("f_", col), col,
                  choices  = sort(unique(data()[[col]])),
                  multiple = TRUE)
    }
  })
})

Reading them back requires constructing the names:

filtered <- reactive({
  d <- data()
  for (col in names(d)) {
    val <- input[[paste0("f_", col)]]
    if (is.null(val)) next
    d <- if (is.numeric(d[[col]])) {
      dplyr::filter(d, .data[[col]] >= val[1], .data[[col]] <= val[2])
    } else {
      dplyr::filter(d, .data[[col]] %in% val)
    }
  }
  d
})

Preserving state

The main annoyance with renderUI(): rebuilding resets the inputs. Preserve values explicitly:

output$controls <- renderUI({
  req(data())
  selectInput("x", "X variable",
              choices  = names(data()),
              selected = isolate(input$x) %||% names(data())[1])
})

isolate() matters — without it, reading input$x inside the renderUI makes it depend on its own output, which is an infinite loop.

`insertUI()` and `removeUI()`

For adding an unknown number of elements without rebuilding the ones already there:

ui <- fluidPage(
  actionButton("add", "Add filter"),
  tags$div(id = "filter_container")
)

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

  counter <- reactiveVal(0)

  observeEvent(input$add, {
    n <- counter() + 1
    counter(n)
    row_id <- paste0("filter_row_", n)

    insertUI(
      selector = "#filter_container",
      where    = "beforeEnd",
      ui = tags$div(
        id = row_id,
        class = "d-flex gap-2 align-items-end mb-2",
        selectInput(paste0("col_", n), "Column", names(adsl), width = "180px"),
        selectInput(paste0("op_", n), "Operator", c("==", "!=", ">", "<"),
                    width = "100px"),
        textInput(paste0("val_", n), "Value", width = "160px"),
        actionButton(paste0("rm_", n), "", icon = icon("trash"),
                     class = "btn-outline-danger")
      )
    )

    # One-shot observer to remove this row
    observeEvent(input[[paste0("rm_", n)]], {
      removeUI(selector = paste0("#", row_id))
      active(setdiff(active(), n))
    }, once = TRUE, ignoreInit = TRUE)
  })

  active <- reactiveVal(integer())
  observeEvent(input$add, active(c(active(), counter())))
}

Observer leaks

Every observeEvent() created inside another observer is a new observer that lives for the rest of the session. Adding and removing 200 filter rows leaves 200 observers running.

Mitigations:

once = TRUE so the observer destroys itself after firing

Capture the handle and destroy it explicitly:

obs <- observeEvent(input[[id]], { ... })
# later
obs$destroy()

Better: use a module per row, and keep a registry of live instances

removeUI() removes the HTML but not the server-side observers or the input values. input$col_3 still exists after row 3 is removed.

Bookmarking

Dynamic UI interacts badly with Shiny’s bookmarking unless you help it:

ui <- function(request) {
  fluidPage(
    bookmarkButton(),
    selectInput("arm", "Arm", arms),
    uiOutput("dynamic")
  )
}

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

  onBookmark(function(state) {
    state$values$custom_filters <- active_filters()
  })

  onRestore(function(state) {
    active_filters(state$values$custom_filters)
  })
}

shinyApp(ui, server, enableBookmarking = "url")

Note ui must be a function of request for bookmarking to work.

Choosing

Does the control already exist, with the same type?
├── Yes ──▶ update*Input()
└── No  ──▶ Is it just visibility?
            ├── Yes, simple client-side condition ──▶ conditionalPanel()
            ├── Yes, server-side condition ──▶ shinyjs::toggle()
            └── No, the structure changes ──▶ Is the number known?
                        ├── Yes ──▶ renderUI()
                        └── No, user adds/removes ──▶ insertUI() + modules

Common mistakes

Mistake	Symptom	Fix
`renderUI` where `update*` would do	Flicker, lost focus, slow	Use `update*Input()`
Missing `ns = ns` in `conditionalPanel`	Panel never shows	Add it
Reading a `renderUI` input without `req()`	Errors on first render	`req(input$x)`
Reading `input$x` unisolated inside its own `renderUI`	Infinite loop	`isolate()`
Observers created in a loop	Memory leak, doubled events	`once = TRUE` or `obs$destroy()`
`removeUI` expected to clear input values	Stale values persist	Track state separately
Rebuilding UI on every keystroke	Unusable	`debounce()` the trigger

Exercise 5.1 — Data-driven controls

Build an app where the user uploads a CSV and the app generates one filter control per column — a range slider for numeric columns, a multi-select for character columns with fewer than 20 distinct values, and a text search box otherwise. Show the filtered row count.

Show solution

library(shiny); library(bslib); library(dplyr); library(readr)

ui <- page_sidebar(
  title = "Generic data filter",
  sidebar = sidebar(
    width = 320,
    fileInput("file", "Upload CSV", accept = ".csv"),
    hr(),
    uiOutput("filters")
  ),
  layout_columns(
    col_widths = c(4, 8),
    value_box("Rows shown", textOutput("n_rows")),
    card(card_header("Data"), DT::DTOutput("table"))
  )
)

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

  raw <- reactive({
    req(input$file)
    read_csv(input$file$datapath, show_col_types = FALSE)
  })

  # --- Build one control per column ---------------------------------------

  output$filters <- renderUI({
    req(raw())

    lapply(names(raw()), function(col) {
      x  <- raw()[[col]]
      id <- paste0("flt_", col)

      if (is.numeric(x) && any(!is.na(x))) {
        sliderInput(id, col,
                    min   = min(x, na.rm = TRUE),
                    max   = max(x, na.rm = TRUE),
                    value = range(x, na.rm = TRUE))
      } else {
        vals <- sort(unique(as.character(x[!is.na(x)])))
        if (length(vals) > 0 && length(vals) < 20) {
          selectInput(id, col, choices = vals, multiple = TRUE)
        } else {
          textInput(id, paste0(col, " (contains)"), value = "")
        }
      }
    })
  })

  # --- Apply them ----------------------------------------------------------

  filtered <- reactive({
    req(raw())
    d <- raw()

    for (col in names(raw())) {
      val <- input[[paste0("flt_", col)]]
      if (is.null(val)) next

      x <- raw()[[col]]

      if (is.numeric(x)) {
        if (length(val) == 2) {
          d <- filter(d, is.na(.data[[col]]) |
                        (.data[[col]] >= val[1] & .data[[col]] <= val[2]))
        }
      } else if (length(val) > 1 || (length(val) == 1 && val %in% unique(x))) {
        d <- filter(d, .data[[col]] %in% val)
      } else if (is.character(val) && nzchar(val)) {
        d <- filter(d, grepl(val, .data[[col]], ignore.case = TRUE))
      }
    }
    d
  })

  output$n_rows <- renderText({
    sprintf("%s of %s", format(nrow(filtered()), big.mark = ","),
            format(nrow(raw()), big.mark = ","))
  })

  output$table <- DT::renderDT(
    DT::datatable(filtered(), rownames = FALSE,
                  options = list(pageLength = 15, scrollX = TRUE))
  )
}

Three decisions worth explaining:

Numeric filters keep NA rows (is.na(.data[[col]]) | ...). A range slider silently dropping every record with a missing value is a data-integrity hazard — a reviewer would conclude those subjects do not exist.
The 20-value threshold distinguishes a categorical variable from free text. It is arbitrary; make it an argument if the app is reused.
Text filters use grepl(), not exact match, because a text box implies search. Consider fixed = TRUE if users are likely to type regex metacharacters accidentally.

For a large file, wrap the text inputs in debounce() so filtering does not run on every keystroke.

Exercise 5.2 — Add and remove filter rows without leaking

Build a query builder where the user clicks “Add condition” to append a filter row (column, operator, value) and can delete any row. Use a module per row so observers are cleaned up properly. Show the resulting filtered data.

Show solution

# R/mod_condition.R -------------------------------------------------------

mod_condition_ui <- function(id, columns) {
  ns <- NS(id)
  tags$div(
    id = ns("row"),
    class = "d-flex gap-2 align-items-end mb-2",
    selectInput(ns("col"), NULL, choices = columns, width = "170px"),
    selectInput(ns("op"),  NULL, choices = c("==", "!=", ">", ">=", "<", "<="),
                width = "90px"),
    textInput(ns("val"), NULL, placeholder = "value", width = "150px"),
    actionButton(ns("remove"), NULL, icon = icon("trash"),
                 class = "btn-outline-danger btn-sm")
  )
}

#' @return list(condition = reactive(), removed = reactive())
mod_condition_server <- function(id, data) {
  moduleServer(id, function(input, output, session) {

    condition <- reactive({
      req(input$col, input$op, nzchar(input$val %||% ""))
      list(col = input$col, op = input$op, val = input$val)
    })

    list(
      condition = condition,
      removed   = reactive(input$remove)
    )
  })
}

# app.R -------------------------------------------------------------------

ui <- bslib::page_sidebar(
  title = "Query builder",
  sidebar = bslib::sidebar(
    width = 480,
    actionButton("add", "Add condition", class = "btn-primary btn-sm"),
    hr(),
    tags$div(id = "conditions")
  ),
  bslib::card(bslib::card_header(textOutput("n_rows")), DT::DTOutput("table"))
)

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

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

  # Registry of live module instances
  rows <- reactiveVal(list())     # named list: id -> module return value
  counter <- reactiveVal(0L)

  observeEvent(input$add, {
    n  <- counter() + 1L
    counter(n)
    id <- paste0("cond_", n)

    insertUI("#conditions", "beforeEnd",
             ui = mod_condition_ui(session$ns(id), names(adsl())))

    handle <- mod_condition_server(id, data = adsl)

    current <- rows()
    current[[id]] <- handle
    rows(current)

    # Self-destructing removal observer
    observeEvent(handle$removed(), {
      removeUI(paste0("#", session$ns(id), "-row"))
      current <- rows()
      current[[id]] <- NULL
      rows(current)
    }, once = TRUE, ignoreInit = TRUE)
  })

  # Apply every live condition
  filtered <- reactive({
    d <- adsl()

    for (h in rows()) {
      cond <- tryCatch(h$condition(), error = function(e) NULL)
      if (is.null(cond)) next

      x <- d[[cond$col]]
      val <- if (is.numeric(x)) suppressWarnings(as.numeric(cond$val)) else cond$val
      if (is.numeric(x) && is.na(val)) next   # unparseable, skip

      keep <- switch(cond$op,
        "==" = x == val, "!=" = x != val,
        ">"  = x >  val, ">=" = x >= val,
        "<"  = x <  val, "<=" = x <= val
      )
      d <- d[which(keep), , drop = FALSE]     # which() drops NA safely
    }
    d
  })

  output$n_rows <- renderText(sprintf("%d rows", nrow(filtered())))
  output$table  <- DT::renderDT(DT::datatable(filtered(), rownames = FALSE))
}

What makes this leak-free and correct:

A module per row. Each row’s inputs are namespaced, so there is no ID arithmetic and no chance of collision after removals.
rows() is a registry, so filtered() iterates over exactly the live rows. Removing a row removes it from the registry, and the stale input values that removeUI() leaves behind are never read.
once = TRUE on the removal observer means it destroys itself, so adding and removing 500 rows leaves no accumulating observers.
which(keep) rather than d[keep, ] — as covered in R Programming lesson 3, logical indexing with NA produces phantom rows.
tryCatch() around h$condition() because req() inside the module raises a condition when the row is incomplete; a half-filled row should be ignored, not crash the pipeline.

Recap

Prefer the cheapest technique: update* > conditionalPanel > shinyjs > renderUI > insertUI
conditionalPanel conditions are JavaScript and need ns = ns inside modules
Inputs created by renderUI() are NULL for at least one round trip — req() them
Preserve state across renderUI rebuilds with isolate(input$x)
removeUI() removes HTML but not observers or input values
Use a module per dynamically added element, plus a registry of live instances

Next: Tables and plots.

Four techniques, in order of preference

update*Input() — change, do not rebuild

conditionalPanel() — client-side visibility

shinyjs — server-side show/hide

renderUI() — structure from data