Dynamiczny interfejs za pomocą renderUI i insertUI

Dynamiczny interfejs użytkownika — dlaczego i kiedy

library(shiny)

# Static UI: columns always shown
# ui <- fluidPage(selectInput('x', ...), selectInput('y', ...))

# Dynamic UI: columns depend on which dataset was loaded
# ui <- fluidPage(fileInput('upload', ...), uiOutput('var_selectors'))

renderUI() i uiOutput()

ui <- fluidPage(
  selectInput('dataset', 'Dataset:', choices = c('iris', 'mtcars')),
  uiOutput('column_selector')   # placeholder
)

server <- function(input, output, session) {
  output$column_selector <- renderUI({
    df <- get(input$dataset)  # reactive dependency on dataset
    selectInput('col', 'Choose Column:',
                choices = names(df))
  })
}

shinyApp(ui, server)

renderUI() z wieloma elementami sterującymi

server <- function(input, output, session) {
  output$filters <- renderUI({
    df    <- get(input$dataset)
    nums  <- names(df)[sapply(df, is.numeric)]

    # One slider per numeric column
    sliders <- lapply(nums, function(col) {
      rng <- range(df[[col]], na.rm = TRUE)
      sliderInput(
        inputId = paste0('filter_', col),
        label   = col,
        min     = rng[1], max = rng[2],
        value   = rng
      )
    })
    tagList(sliders)   # render all sliders
  })
}

insertUI() — dynamiczne dodawanie elementów

server <- function(input, output, session) {
  item_count <- reactiveVal(0)

  observeEvent(input$add_item, {
    item_count(item_count() + 1)
    id <- paste0('item_', item_count())

    insertUI(
      selector = '#item_container',  # CSS selector
      where    = 'beforeEnd',
      ui       = div(
        id    = id,
        style = 'padding: 5px; border: 1px solid #ccc; margin: 3px;',
        textInput(id, paste('Item', item_count()), value = '')
      )
    )
  })
}

removeUI() — usuwanie elementów

server <- function(input, output, session) {
  observeEvent(input$remove_last, {
    # Remove the last item div
    n <- isolate(item_count())
    if (n > 0) {
      removeUI(selector = paste0('#item_', n))
      item_count(n - 1)
    }
  })

  observeEvent(input$clear_all, {
    # Remove all items matching a class
    removeUI(selector = '.dynamic-item', multiple = TRUE)
    item_count(0)
  })
}

conditionalPanel() — widoczność po stronie klienta

ui <- fluidPage(
  selectInput('plot_type', 'Plot Type:',
              choices = c('scatter', 'histogram', 'boxplot')),

  # Only shown when scatter is selected
  conditionalPanel(
    condition = "input.plot_type == 'scatter'",
    selectInput('x_var', 'X Variable:', choices = names(mtcars)),
    selectInput('y_var', 'Y Variable:', choices = names(mtcars))
  ),

  # Only shown when histogram is selected
  conditionalPanel(
    condition = "input.plot_type == 'histogram'",
    sliderInput('bins', 'Number of bins:', 5, 50, 20)
  ),

  plotOutput('main_plot')
)

updateSelectInput() — modyfikowanie istniejących danych wejściowych

server <- function(input, output, session) {
  # When dataset changes, update the column selector
  observeEvent(input$dataset, {
    df <- get(input$dataset)
    updateSelectInput(
      session  = session,
      inputId  = 'column',
      choices  = names(df),
      selected = names(df)[1]
    )
  })

  # Reset slider when reset button pressed
  observeEvent(input$reset_btn, {
    updateSliderInput(session, 'n_items',
                     value = 20, min = 1, max = 100)
  })
}

updateSliderInput() i updateNumericInput()

server <- function(input, output, session) {
  # When data loads, set slider max to actual data length
  observeEvent(input$load_data, {
    data <- readRDS(input$upload$datapath)

    updateSliderInput(session, 'row_slider',
      min   = 1,
      max   = nrow(data),
      value = c(1, min(50, nrow(data)))
    )

    updateNumericInput(session, 'page_size',
      max   = nrow(data),
      value = min(10, nrow(data))
    )
  })
}

Uzyskiwanie dostępu do danych wejściowych renderUI za pomocą req()

server <- function(input, output, session) {
  # dynamic input: 'col' is created by renderUI
  output$column_selector <- renderUI({
    selectInput('col', 'Column:', choices = names(get(input$dataset)))
  })

  output$summary_stats <- renderPrint({
    req(input$col)           # wait until 'col' exists
    req(input$dataset)       # and dataset is chosen
    df <- get(input$dataset)
    summary(df[[input$col]])
  })
}

Dynamiczne karty za pomocą appendTab()

ui <- fluidPage(
  actionButton('add_tab', 'Open New Analysis Tab'),
  tabsetPanel(id = 'analysis_tabs', type = 'tabs')
)

server <- function(input, output, session) {
  tab_count <- reactiveVal(0)

  observeEvent(input$add_tab, {
    tab_count(tab_count() + 1)
    n <- tab_count()
    appendTab(
      inputId = 'analysis_tabs',
      select  = TRUE,
      tab = tabPanel(
        title = paste('Analysis', n),
        value = paste0('tab_', n),
        plotOutput(paste0('plot_', n)),
        actionButton(paste0('close_', n), 'Close')
      )
    )
  })
}

renderUI a insertUI — kiedy używać którego

# Decision guide:
# - 'Show filter only when advanced mode' -> conditionalPanel
# - 'Populate column choices from loaded CSV' -> updateSelectInput
# - 'Show different controls per selected tab' -> renderUI
# - 'Add a row editor for each row user adds' -> insertUI
# - 'Remove a row editor' -> removeUI

# Combining strategies:
server <- function(input, output, session) {
  # Use renderUI for column selectors (replaces whole block)
  output$col_selectors <- renderUI({ ... })
  # Use insertUI for dynamically added rows
  observeEvent(input$add_row, { insertUI(...) })
  # Use conditionalPanel for show/hide (in UI, no server code)
}

Szybkie sprawdzenie

Podsumowanie dynamicznego interfejsu użytkownika

# Typical pattern: dynamic column selector
ui <- fluidPage(
  fileInput('upload', 'Upload CSV'),
  uiOutput('col_ui'),          # placeholder
  plotOutput('col_plot')
)

server <- function(input, output, session) {
  df <- reactive({
    req(input$upload)
    read.csv(input$upload$datapath)
  })

  output$col_ui <- renderUI({
    req(df())
    selectInput('col', 'Column:', choices = names(df()))
  })

  output$col_plot <- renderPlot({
    req(input$col)
    hist(df()[[input$col]])
  })
}