リアクティブプログラミングの深掘り

リアクティビティ：基本概念

library(shiny)

# Simplest reactive relationship:
# output depends on input — Shiny tracks this automatically
server <- function(input, output, session) {
  output$result <- renderText({
    paste('You typed:', input$text_in)  # depends on text_in
  })
}

reactive({}) — 計算の共有

server <- function(input, output, session) {
  # Computed once, shared by multiple outputs
  filtered_data <- reactive({
    subset(mtcars, cyl == input$cyl_select)
  })

  output$plot  <- renderPlot({ plot(filtered_data()$wt,
                                    filtered_data()$mpg) })
  output$table <- renderTable({ filtered_data() })
  # filtered_data() is only recomputed once when cyl_select changes
}

reactiveVal() — 単一のリアクティブ値

server <- function(input, output, session) {
  counter <- reactiveVal(0)   # initial value = 0

  observeEvent(input$increment, {
    counter(counter() + 1)    # read current, write new
  })

  observeEvent(input$reset, {
    counter(0)                 # reset to 0
  })

  output$count <- renderText(paste('Count:', counter()))
}

reactiveValues() — 複数の状態変数

server <- function(input, output, session) {
  state <- reactiveValues(
    data         = NULL,
    current_page = 1,
    total_rows   = 0
  )

  observeEvent(input$load_btn, {
    state$data       <- read.csv(input$file$datapath)
    state$total_rows <- nrow(state$data)
    state$current_page <- 1
  })

  output$info <- renderText({
    paste('Page', state$current_page, '| Rows:', state$total_rows)
  })
}

observeEvent() — イベントへの応答

server <- function(input, output, session) {
  observeEvent(input$save_btn, {
    # Runs once each time save_btn is clicked
    write.csv(current_data(), '/tmp/export.csv', row.names = FALSE)
    showNotification('Saved!', type = 'message')
  })

  observeEvent(input$reset_btn, {
    updateTextInput(session, 'search', value = '')
    updateSliderInput(session, 'range', value = c(0, 100))
  })
}

eventReactive() — 必要なときに値を計算

server <- function(input, output, session) {
  # Only re-run the model when 'Run Model' is clicked
  model_result <- eventReactive(input$run_btn, {
    # Expensive computation — only on button click
    lm(as.formula(input$formula), data = get(input$dataset))
  })

  output$summary <- renderPrint({
    summary(model_result())
  })
}

isolate() — 依存関係を作らずに読み取る

server <- function(input, output, session) {
  observeEvent(input$add_row_btn, {
    # Read current_data without depending on it
    current <- isolate(data_rv())
    new_row <- data.frame(
      id    = nrow(current) + 1,
      value = input$new_value
    )
    data_rv(rbind(current, new_row))
  })
}

invalidateLater() — 自動更新

server <- function(input, output, session) {
  live_data <- reactive({
    invalidateLater(5000)   # re-run every 5 seconds
    # Fetch fresh data from external source
    httr2::request('https://api.example.com/stats') |>
      httr2::req_perform() |>
      httr2::resp_body_json()
  })

  output$live_plot <- renderPlot({
    plot(live_data()$time, live_data()$value, type = 'l')
  })
}

reactlog — リアクティブグラフをデバッグする

library(reactlog)

# Enable reactlog BEFORE launching the app
reactlog_enable()

# Launch your app
shinyApp(ui, server)

# After interacting in the browser, in the R console:
shiny::reactlogShow()

# A viewer opens showing the reactive graph
# with timestamps and invalidation chains

リアクティブ分離のアンチパターン

server <- function(input, output, session) {
  # WRONG: output depends on input$name, but also re-runs
  # every time input$slider changes (unintended dependency)
  output$msg <- renderText({
    paste(input$name, 'total:', input$slider * 2)
  })

  # CORRECT: output only responds to input$name changes;
  # slider is read as a snapshot
  output$msg_correct <- renderText({
    slider_val <- isolate(input$slider)
    paste(input$name, 'snapshot total:', slider_val * 2)
  })
}

observe() と observeEvent()

server <- function(input, output, session) {
  # observe: re-runs on ANY change in input$x or input$y
  observe({
    cat('x or y changed:', input$x, input$y, '\n')
  })

  # observeEvent: only runs when button is clicked
  observeEvent(input$submit_btn, {
    cat('Form submitted with x =', isolate(input$x), '\n')
  }, ignoreNULL = TRUE, ignoreInit = TRUE)
}

確認問題

リアクティブプログラミングのまとめ

server <- function(input, output, session) {
  # State
  rv <- reactiveValues(data = NULL, n = 0)

  # Load data on button click
  observeEvent(input$load, {
    rv$data <- read.csv(input$file$datapath)
    rv$n    <- nrow(rv$data)
  })

  # Expensive model only on 'Run' click
  model <- eventReactive(input$run, {
    lm(y ~ ., data = isolate(rv$data))
  })

  output$summary <- renderPrint({ summary(model()) })
}