如何将全局数据传递到拆分后的Shiny模块中？

我正在开发一个拆分模块到不同脚本的Shiny应用，但模块内调用数据时出错。单脚本版本正常运行，拆分UI和Server模块后，出现object 'purchases' not found的错误。

错误提示：

错误信息：object 'purchases' not found

单脚本版本可正常显示统计表格，支持选择查看均值或中位数数据。我需要解决的问题是：如何将全局数据传递到Server模块中，完成均值和中位数的计算？

拆分后无法运行的代码 #

主应用代码 #

startDate <- as.Date("2023-01-01")
endDate <- as.Date("2023-06-01")
dates = seq.Date(from = startDate, to = endDate, by = "days")
dates <- rep(dates, each = 10)
propertyPrices <- round(rnorm(length(dates), mean = 100000, sd = 20000), 2)
purchases <- data.frame(collectionDate = dates, price = propertyPrices)
propertyRentals <- round(rnorm(length(dates), mean = 1000, sd = 200), 2)
rentals <- data.frame(collectionDate = dates, price = propertyRentals)

library(shiny)
library(tidyverse)


ui_table_code <- modules::use("ui_code.R")
server_table_code <- modules::use("server_code.R")

ui <- fluidPage(
  ui_table_code$ui_controls("dygraph"),
  ui_table_code$ui_table("dygraph")
)


server <- function(input, output) {
  server_table_code$server_summary("dygraph")
}


shinyApp(ui = ui, server = server)

Server模块代码（server_code.R） #

modules::import("shiny", "moduleServer", "reactive", "renderTable")
modules::import("dygraphs", "renderDygraph", "dyOptions", "dySeries", "dyAxis", "dygraph")
modules::import("magrittr", "%>%")
modules::import("tibble", "column_to_rownames", "add_column")
modules::import("dplyr", "select", "filter", "bind_rows", "mutate", "ungroup", "summarise", "group_by", "n", "full_join", "case_when", "distinct", "bind_rows", "arrange")
modules::import("zoo", "rollapply")
modules::import("stats", "median")

server_summary <- function(id){
  moduleServer(id, function(input, output, session){
    comprar_stats = reactive({
      purchases %>%
        filter(collectionDate > as.Date("2022-09-27")) %>%
        filter(price < 1000000) %>%
        filter(price > 100000) %>%
        group_by(collectionDate) %>%
        summarise(
          mean_price = mean(price),
          mean_price = round(mean_price, 0),
          propertiesListed = n(),
          median_price = median(price),
          median_price = round(median_price, 0)
        ) %>%
        ungroup()
    })
    mean_median_choice <- reactive({tolower(input$metric2)})
    output$myTable = renderTable({
      comprar_stats() %>%
        select(c("collectionDate", "propertiesListed", contains(mean_median_choice())))
    })
  })
}

UI模块代码（ui_code.R） #

modules::import("shiny", "NS", "selectInput", "tableOutput")
modules::import("purrr", "map_chr", "pluck")
modules::import("htmltools", "tagList", "tags")
modules::import("dygraphs", "dygraphOutput")

ui_controls <- function(id) {
  ns <- NS(id)
  selectInput(
    ns("metric2"), "Select Mean or Median",
    choices = c("Mean", "Median"),
    width = NULL,
    selectize = TRUE,
    selected = "Mean"
  )
}


ui_table <- function(id){
  ns <- NS(id)
  tags$div(
    class = "mytable",
    tableOutput(ns("myTable"))
  )
}

可正常运行的单脚本应用代码 #

startDate <- as.Date("2023-01-01")
endDate <- as.Date("2023-06-01")
dates = seq.Date(from = startDate, to = endDate, by = "days")
dates <- rep(dates, each = 10)
propertyPrices <- round(rnorm(length(dates), mean = 100000, sd = 20000), 2)
purchases <- data.frame(collectionDate = dates, price = propertyPrices)
propertyRentals <- round(rnorm(length(dates), mean = 1000, sd = 200), 2)
rentals <- data.frame(collectionDate = dates, price = propertyRentals)

library(shiny)
library(tidyverse)


ui_controls <- function(id) {
  ns <- NS(id)
  selectInput(
    ns("metric2"), "Select Mean or Median",
    choices = c("Mean", "Median"),
    width = NULL,
    selectize = TRUE,
    selected = "Mean"
  )
}


ui_table <- function(id){
  ns <- NS(id)
  tags$div(
    class = "mytable",
    tableOutput(ns("myTable"))
  )
}

server_summary <- function(id){
  moduleServer(id, function(input, output, session){
    comprar_stats = reactive({
      purchases %>%
        filter(collectionDate > as.Date("2022-09-27")) %>%
        filter(price < 1000000) %>%
        filter(price > 100000) %>%
        group_by(collectionDate) %>%
        summarise(
          mean_price = mean(price),
          mean_price = round(mean_price, 0),
          propertiesListed = n(),
          median_price = median(price),
          median_price = round(median_price, 0)
        ) %>%
        ungroup()
    })
    mean_median_choice <- reactive({tolower(input$metric2)})
    output$myTable = renderTable({
      comprar_stats() %>%
        select(c("collectionDate", "propertiesListed", contains(mean_median_choice())))
    })
  })
}



ui <- fluidPage(
  ui_controls("dygraph"),
  ui_table("dygraph")
)


server <- function(input, output) {
  server_summary("dygraph")
}


shinyApp(ui = ui, server = server)

问题核心是：使用modules::use()加载模块时，模块运行在独立环境中，无法直接访问主脚本的全局变量purchases。推荐两种解决方法：

方法1：修改模块函数，接收数据参数（推荐） #

这种方法保持模块的独立性和可复用性，直接在模块函数中添加数据参数，从主应用传递数据：

修改Server模块（server_code.R） #

# 保留原有import代码不变
server_summary <- function(id, data){  # 新增data参数
  moduleServer(id, function(input, output, session){
    comprar_stats = reactive({
      data %>%  # 将原purchases替换为传入的data参数
        filter(collectionDate > as.Date("2022-09-27")) %>%
        filter(price < 1000000) %>%
        filter(price > 100000) %>%
        group_by(collectionDate) %>%
        summarise(
          mean_price = mean(price),
          mean_price = round(mean_price, 0),
          propertiesListed = n(),
          median_price = median(price),
          median_price = round(median_price, 0)
        ) %>%
        ungroup()
    })
    mean_median_choice <- reactive({tolower(input$metric2)})
    output$myTable = renderTable({
      comprar_stats() %>%
        select(c("collectionDate", "propertiesListed", contains(mean_median_choice())))
    })
  })
}

修改主应用的server部分 #

server <- function(input, output) {
  # 调用模块时传入purchases数据
  server_table_code$server_summary("dygraph", data = purchases)
}

方法2：将数据存入全局环境 #

如果不想修改模块参数，可以在主脚本中将数据放入全局环境，让模块直接访问：

修改主应用代码 #

在创建purchases后添加以下代码：

# 将数据存入全局环境
assign("purchases", purchases, envir = .GlobalEnv)

这种方法实现简单，但会破坏模块的独立性，不推荐在复杂应用中使用。

内容的提问来源于stack exchange，提问作者user113156