Passing reactives between Shiny modules to get dynamic updates答案

【问题标题】：Passing reactives between Shiny modules to get dynamic updatesPassing reactives between Shiny modules to get dynamic updates
【发布时间】：2022-12-19 09:48:16
【问题描述】：

I'm new to R and Shiny, and I'm writing a Shiny app that allows the user to create/read/update/delete records in a MariaDB database. When the user adds a record, I want the UI to display the updated contents of the table.

It works if all the code is in a single app.R, but when I break it into Shiny modules (saveNew and displaytbl), I can't get the datatable to automatically update, probably because I haven't figured out the correct reactive 'plumbing' that I need to pass data between modules.

app.R:

library(shiny)
library(dplyr)
library(DT)

ui <- fluidPage(
  fluidRow(
    saveNewUI("saveNew")),
  fluidRow(
    displaytblUI("displaytbl")
  )
)

server <- function(input, output, session) {
  # Load initial contents from database
  tibl <- reactiveVal(loadSites())
  
  # Display table
  observeEvent(tibl(), { # without observe(), can't access tibl outside reactive context
    displaytblServer("displaytbl", tibl())
  })
  
  # Save a new record to the table, and update the tibl reactiveVal
  tibl(saveNewServer("saveNew"))
}

shinyApp(ui, server)

displaytbl.R:

library(shiny)
library(DT)

displaytblUI <- function(id) {
  ns <- NS(id)
  tagList(
    DT::dataTableOutput(ns("datatable"))
  )
}

displaytblServer <- function(id, datatable) {
  moduleServer(id, function(input, output, session) {
    observeEvent(datatable, {
      output$datatable <- renderDataTable(datatable())
    })
  })
}

saveNew.R:

library(shiny)

saveNewUI <- function(id) {
  ns <- NS(id)
  tagList(
    textInput(ns("siteName"), "Add a site"),
    actionButton(ns("btnSave"), "Save"),
  )
}

saveNewServer <- function(id) {
  moduleServer(id, function(input, output, session) {
    observeEvent(input$btnSave, {
      saveSite(input$siteName)
    })
    # Return the updated database table 
    reactive(loadSites())
  })
}

database.R (helper functions):

loadSites <- function() {
  query <- "SELECT * FROM names"
  res <- as_tibble(dbGetQuery(pool, query))
}

saveSite <- function(siteName) {
  query <- paste0("INSERT INTO names (name) VALUES (?)")
  params <- list(siteName)
  dbExecute(pool, query, params)
}

Expecting the datatable to update when the user clicks the Save button. The database gets updated, but the datatable in the UI does not (until I reload/refresh the app).

【问题讨论】：

Where you do displaytblServer("displaytbl", tibl()), you should pass the reactive inputwithout(), and inside that module, it should be observeEvent(datatable(),.... The idea is you pass a reactive expression to a module, and evaluate it inside the module.
In fact this block: observeEvent(datatable, { output$datatable <- renderDataTable(datatable()) }) should be without the observeEvent entirely. The datatable is already redrawn when the reactive datatable() changes
@RemkoDuursma Thank you! OK, I changed the call to this: displaytblServer("displaytbl", tibl) and the body of moduleServer to just: output$datatable <- renderDataTable(datatable()). Now I get Warning: Error in <Anonymous>: 'data' must be 2-dimensional (e.g. data frame or matrix). The bottom of the stack trace is this: 101: func 88: renderFunc 87: renderFunc 83: renderFunc 82: output$displaytbl-datatable 1: shiny::runApp
I'll post the first part of the output below. It's as if renderDataTable() is seeing datatable() as the function loadSites(), rather than theresultof loadSites(). Listening on http://127.0.0.1:3348 function () - attr(*, "observable")=Classes 'Observable', 'R6' reactive({ loadSites() }) - attr(*, "cacheHint")=List of 1 ..$ userExpr: language { loadSites() } - attr(*, "class")= chr [1:3] "reactiveExpr" "reactive" "function" Warning: Error in <Anonymous>: 'data' must be 2-dimensional (e.g. data frame or matrix) < stack trace follows here >

标签： r shiny

【解决方案1】：

After incorporating suggestions from @remko-duursma, I was able to get rid of my error by removing the observeEvent() from my app server(), and also passing the tibl reactiveVal as an argument to saveNewServer(), where it's used to update the database. My working code is below.

app server function:

server <- function(input, output, session) {
  # Load initial contents from database
  tibl <- reactiveVal(loadSites())
  
  # Display table
  displaytblServer("displaytbl", tibl)
  
  saveNewServer("saveNew", tibl)
}

saveNewServer function:

saveNewServer <- function(id, tibl) {
  moduleServer(id, function(input, output, session) {
    observeEvent(input$btnSave, {
      saveSite(input$siteName)
      tibl(loadSites())
    })
  })
}

displaytblServer function:

displaytblServer <- function(id, datatable) {
  moduleServer(id, function(input, output, session) {
    output$datatable <- renderDataTable(datatable())
  })
}

【讨论】：