Shiny Dashboard切换参数后第二标签页无法刷新问题

问题描述 #

开发的Shiny Dashboard包含两个标签页，要求参数变更时自动刷新数据：第一标签页参数变更后可正常刷新，但第二标签页虽使用了reactive函数，参数变更后仍无法刷新。以下是简化测试代码：

library(quantmod)
library(shiny)
library(dplyr)
library(purrr)
library(stringr)

get_data <- function(symbols = c("AAPL", "MSFT", "META", "ORCL",
                                 "TSLA", "GOOG")) {
    syms <- getSymbols(symbols, from = "2020/01/01", 
                       to = Sys.Date(), periodicity = "daily")
    map_dfr(syms, function(sym) {
        raw_data <- get(sym)
        raw_data %>%
            as_tibble() %>% # as_tibble will convert to tibble
            set_names(c("OPEN", "HIGH", "LOW", "CLOSE", "VOLUME", "ADJUSTED")) %>% 
            mutate(SYMBOL = sym,
                   DATE = index(raw_data)) %>% 
            select(SYMBOL, DATE, OPEN, HIGH, LOW, CLOSE, VOLUME, ADJUSTED)
    })}

if (!exists("df_all")) {df_all <- get_data()}

df_rep_data <- tribble(~ RunDate, ~ ListStocks,
                       "2020-01-06", "AAPL, GOOG, TSLA",
                       "2021-01-04", "ORCL",
                       "2022-01-04", "META, MSFT") %>% 
            mutate(RunDate = as.Date(RunDate))

make_table <- function(symbol, dat = df_all) {
    dat %>% 
        filter(SYMBOL == symbol) %>% 
        select(DATE, OPEN, HIGH, LOW, CLOSE, VOLUME) %>% 
        slice(1:5)}
symb_ui <- function(id) {
    ns <- NS(id)
    tagList(
        tags$h4(textOutput(ns("symbol"))), 
        tableOutput(ns("table"))
)}
symb_server <- function(id, get_symbol_name) {
    moduleServer(id, function(input, output, session) {
        ns <- session$ns
        output$symbol <- renderText(get_symbol_name())
        output$table <- renderTable(make_table(get_symbol_name()))
        })}


OneStock_ui <- function(id) {
    ns <- NS(id)
    tagList(
        tags$h4(textOutput(ns("OneStocksymbol"))), 
        tableOutput(ns("OneStocktable"))
)}


OneStock_server <- function(id, get_symbol_date) {
    moduleServer(id, function(input, output, session) {
        ns <- session$ns
        output$OneStocksymbol <- renderText(get_symbol_date())
        output$OneStocktable <- renderTable(make_table(get_symbol_date()))
    })}


ui <- fluidPage(
    tabsetPanel(
        tabPanel(
            selectInput("run_date", "Run Date", df_rep_data %>% pull(RunDate)),
            tags$h2(textOutput("date_output")), 
            tags$h3(textOutput("lst_symb_output")),
            uiOutput("symbols_output")),
        tabPanel(
            textInput("OneStockChart_input",'OneStockAnalysis', value = 'MSFT'),
            uiOutput("OneStockAnalysis_output"))
    ))


server <- function(input, output, session) {
    handler <- list()
    get_syms <- list()
    get_syms_onestock <- list() 
    handler_onestock <- list()
    
    output$date_output <- renderText(req(input$run_date))
    output$lst_symb_output <- renderText({
        df_rep_data %>% 
            filter(RunDate == req(input$run_date)) %>% 
            pull(ListStocks)
    })
    
    output$symbols_output <- renderUI({
        symbols <- df_rep_data %>%
            filter(RunDate == req(input$run_date)) %>%
            pull(ListStocks) %>%
            str_split(fixed(", ")) %>%
            unlist()
        syms <- vector("list", length(symbols)) %>%
            set_names(symbols)
        for (sym in symbols) {
            local({ 
                my_sym <- sym
                syms[[my_sym]] <<- symb_ui(my_sym)
                get_syms[[my_sym]] <<- reactive(my_sym)
                handler[[my_sym]] <<- symb_server(my_sym, get_syms[[my_sym]])
            })
        }
        tagList(syms)
    })
    
    output$OneStockAnalysis_output <- renderUI({
        symbols_onestock <- list(req(input$OneStockChart_input)) %>%
            unlist()
        syms_onestock <- vector("list", length(symbols_onestock)) %>%
            set_names(symbols_onestock)
        for (sym_onestock in symbols_onestock) {
            local({ 
                my_sym_onestock <- sym_onestock
                syms_onestock[[my_sym_onestock]] <<- symb_ui(my_sym_onestock)
                get_syms_onestock[[my_sym_onestock]] <<- reactive(my_sym_onestock)
                handler_onestock[[my_sym_onestock]] <<- symb_server(my_sym_onestock, get_syms_onestock[[my_sym_onestock]])
            })
        }
        tagList(syms_onestock)
    })}

shinyApp(ui =  ui, server = server) 

原因分析 #

1. Reactive对象无输入依赖：第二标签页中，reactive(my_sym_onestock)仅捕获了renderUI执行时的输入值，没有与input$OneStockChart_input建立响应式依赖，导致输入变化时reactive不会触发更新。
2. 模块ID冲突：每次输入变化时，会重复创建相同ID的模块，Shiny不会自动重建已有ID的模块，因此旧模块的内容不会更新。

修复方案 #

• 将依赖输入的reactive对象移到renderUI外部，直接绑定input$OneStockChart_input，确保输入变化时能触发响应。
• 简化第二标签页的模块调用逻辑，因为仅需展示单个股票，无需循环创建模块，直接调用symb_ui并传入固定ID即可。

修改后完整代码 #

library(quantmod)
library(shiny)
library(dplyr)
library(purrr)
library(stringr)

get_data <- function(symbols = c("AAPL", "MSFT", "META", "ORCL",
                                 "TSLA", "GOOG")) {
    syms <- getSymbols(symbols, from = "2020/01/01", 
                       to = Sys.Date(), periodicity = "daily")
    map_dfr(syms, function(sym) {
        raw_data <- get(sym)
        raw_data %>%
            as_tibble() %>% 
            set_names(c("OPEN", "HIGH", "LOW", "CLOSE", "VOLUME", "ADJUSTED")) %>% 
            mutate(SYMBOL = sym,
                   DATE = index(raw_data)) %>% 
            select(SYMBOL, DATE, OPEN, HIGH, LOW, CLOSE, VOLUME, ADJUSTED)
    })}

if (!exists("df_all")) {df_all <- get_data()}

df_rep_data <- tribble(~ RunDate, ~ ListStocks,
                       "2020-01-06", "AAPL, GOOG, TSLA",
                       "2021-01-04", "ORCL",
                       "2022-01-04", "META, MSFT") %>% 
            mutate(RunDate = as.Date(RunDate))

make_table <- function(symbol, dat = df_all) {
    dat %>% 
        filter(SYMBOL == symbol) %>% 
        select(DATE, OPEN, HIGH, LOW, CLOSE, VOLUME) %>% 
        slice(1:5)}

symb_ui <- function(id) {
    ns <- NS(id)
    tagList(
        tags$h4(textOutput(ns("symbol"))), 
        tableOutput(ns("table"))
)}

symb_server <- function(id, get_symbol_name) {
    moduleServer(id, function(input, output, session) {
        output$symbol <- renderText(get_symbol_name())
        output$table <- renderTable(make_table(get_symbol_name()))
        })}

ui <- fluidPage(
    tabsetPanel(
        tabPanel(
            "多股票展示",
            selectInput("run_date", "Run Date", df_rep_data %>% pull(RunDate)),
            tags$h2(textOutput("date_output")), 
            tags$h3(textOutput("lst_symb_output")),
            uiOutput("symbols_output")),
        tabPanel(
            "单股票分析",
            textInput("OneStockChart_input",'输入股票代码', value = 'MSFT'),
            symb_ui("single_stock") # 直接使用固定ID的模块UI
        )
    ))

server <- function(input, output, session) {
    handler <- list()
    get_syms <- list()
    
    # 第一标签页逻辑保持不变
    output$date_output <- renderText(req(input$run_date))
    output$lst_symb_output <- renderText({
        df_rep_data %>% 
            filter(RunDate == req(input$run_date)) %>% 
            pull(ListStocks)
    })
    
    output$symbols_output <- renderUI({
        symbols <- df_rep_data %>%
            filter(RunDate == req(input$run_date)) %>%
            pull(ListStocks) %>%
            str_split(fixed(", ")) %>%
            unlist()
        syms <- vector("list", length(symbols)) %>%
            set_names(symbols)
        for (sym in symbols) {
            local({ 
                my_sym <- sym
                syms[[my_sym]] <<- symb_ui(my_sym)
                get_syms[[my_sym]] <<- reactive(my_sym)
                handler[[my_sym]] <<- symb_server(my_sym, get_syms[[my_sym]])
            })
        }
        tagList(syms)
    })
    
    # 第二标签页修复：创建依赖输入的reactive对象
    current_stock <- reactive({
        req(input$OneStockChart_input)
        input$OneStockChart_input
    })
    
    # 调用模块服务器，传入响应式的股票代码
    symb_server("single_stock", current_stock)
}

shinyApp(ui =  ui, server = server) 

修复说明 #

1. 第二标签页直接在UI中调用symb_ui("single_stock")，无需通过renderUI动态生成，避免ID冲突。
2. 在服务器端创建current_stock reactive对象，直接依赖input$OneStockChart_input，确保输入变化时自动触发更新。
3. 将current_stock传入symb_server，模块内部的renderText和renderTable会自动响应reactive对象的变化，实现数据刷新。

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