R Shiny模块开发：如何向模块内的子模块传递更新后的数据？

问题核心 #

你需要实现点击按钮后，根据日期范围过滤事件日志并动态更新Process Map，但当前模块间参数传递逻辑有误，无法将过滤后的数据传递给pr模块。

修改方案与代码调整 #

1. 重构prServer模块

将prServer的参数改为接受响应式数据（reactive），确保能动态响应数据变化：

prUI <- function(id){
    ns <- NS(id)
    grVizOutput(ns("Pr_map"))
}

prServer <- function(id, my_events){                      # my_events 为响应式对象
    moduleServer(id, function(input, output, session){
        output$Pr_map <- renderGrViz({
            # 调用 my_events() 获取最新数据
            my_events() %>% process_map(type_edges = frequency("relative_case"))
        })
    })
}

2. 调整主Server逻辑

创建reactiveVal存储待展示的事件数据，初始值为原始events，并将其传递给prServer：

server <- function(input, output, session) {
    input_time <- dateRangeServer('time')
    
    # 创建响应式变量，初始值为原始事件日志
    current_events <- reactiveVal(events)
    
    # 将current_events包装为reactive传递给prServer
    prServer('PR_map', reactive({ current_events() }))
    
    actionButtonServer('button1', input_time, current_events)
}

3. 修改actionButtonServer模块

让按钮模块能够更新current_events响应式变量，触发pr模块重新渲染：

actionButtonServer <- function(id, input_time, current_events){
    moduleServer(id, function(input, output, session){
        observeEvent(input$PLOT, {
            print("Button Check")
            
            time <- input_time$time()
            
            # 按日期范围过滤事件数据
            events_Filtered <- filter_time_period(events, interval = ymd(c(time[1]+1, time[2]+1)), filter_method = "complete")
            
            # 更新响应式变量，触发Process Map更新
            current_events(events_Filtered)
        })
    })
}

完整代码 #

# 读取数据并创建Event Log
data <- read.csv2(file = "Data/FX_test.csv", stringsAsFactors = FALSE, na.strings=c(""))

df_use <- data

df_use$Timestamp = as.POSIXct(df_use$Timestamp, format = "%Y-%m-%d %H:%M:%S")

#Create Event Log
events <- bupaR::activities_to_eventlog(
    df_use,
    case_id = 'Case.ID',
    activity_id = 'Activity',
    resource_id = 'User',
    timestamp = c('Timestamp', 'Timestamp')
)

# 日期范围选择模块
dateRangeUI <- function(id){
    ns <- NS(id)
    dateRangeInput(ns("time"), h5(strong(em("DATE RANGE"))), start = as.Date(min(substr(df_use$Timestamp,0,10))),
                   min = as.Date(min(substr(df_use$Timestamp,0,10))), max = as.Date(max(substr(df_use$Timestamp,0,10))), end = as.Date(max(substr(df_use$Timestamp,0,10))))
    
}

dateRangeServer <- function(id){
    moduleServer(id, function(input, output, session){
        return(list(time = reactive({input$time})))
    })
}

# Process Map模块
prUI <- function(id){
    ns <- NS(id)
    grVizOutput(ns("Pr_map"))
}

prServer <- function(id, my_events){                      # my_events 为响应式对象
    moduleServer(id, function(input, output, session){
        output$Pr_map <- renderGrViz({
            my_events() %>% process_map(type_edges = frequency("relative_case"))
        })
    })
}

# 按钮模块
actionButtonUI <- function(id){
    ns <- NS(id)
    actionButton(ns("PLOT"), label = "PLOT", style = "color: #fff; background-color: #337ab7;border-color: #2e6da4")
}

actionButtonServer <- function(id, input_time, current_events){
    moduleServer(id, function(input, output, session){
        observeEvent(input$PLOT, {
            print("Button Check")
            
            time <- input_time$time()
            
            events_Filtered <- filter_time_period(events, interval = ymd(c(time[1]+1, time[2]+1)), filter_method = "complete")
            
            current_events(events_Filtered)
        })
    })
}

# 主UI与Server
ui <- fluidPage(
    dateRangeUI("time"),
    actionButtonUI('button1'),
    prUI("PR_map")
)

server <- function(input, output, session) {
    input_time <- dateRangeServer('time')
    
    current_events <- reactiveVal(events)
    
    prServer('PR_map', reactive({ current_events() }))
    
    actionButtonServer('button1', input_time, current_events)
}

shinyApp(ui = ui, server = server)

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