AWS服务器上Shiny应用浏览器刷新不更新场景列表问题求助

你的问题根源在于下拉列表的选项在应用启动时只加载了一次，之后即使数据库里新增了数据，前端的选项也不会自动刷新。要解决这个问题，我们需要让下拉列表能够动态从数据库重新获取最新的选项，而不是只在启动时加载一次。

下面是具体的修改方案：

1. 调整UI结构，为下拉列表预留动态生成位置 #

首先在UI里不要直接写死selectInput，而是用uiOutput占位，让Server端负责动态生成这个组件：

ui <- fluidPage(
 sidebarLayout(
 sidebarPanel(
 actionButton("create_scenario", "Create Scenario"),
 actionButton("load_scenario","load scenario"),
 # 用uiOutput占位，由server端动态生成下拉选择框
 uiOutput("scenario_select"),
 verbatimTextOutput("selected")
 ),
 mainPanel(
 uiOutput('tabs'),
 uiOutput("input"),
 uiOutput("inputs"),
 uiOutput("inputss")
 )
 )
)

2. 在Server端实现动态获取与更新逻辑 #

我们需要做三件事：

• 写一个复用函数来获取最新的场景列表
• 应用启动时初始化下拉列表
• 保存新场景后，立即更新下拉列表的选项

推荐方案：使用updateSelectInput高效更新 #

这种方式不需要重新渲染整个组件，直接更新选项，性能更优：

server <- function(input, output,session) {

  # 定义复用函数：从数据库获取最新场景列表
  get_latest_scenarios <- function() {
    req(pool) # 确保连接池已初始化
    # 提取为向量格式，适配selectInput的choices要求
    dbGetQuery(pool,"select available_scenario from scenario_name;")[[1]]
  }

  # 初始化下拉选择框
  output$scenario_select <- renderUI({
    mychoices <- get_latest_scenarios()
    selectInput('n', "available scenarios", choices = mychoices, multiple = TRUE)
  })

  observeEvent(input$create_scenario,{
    output$input <- renderUI({
      mainPanel(
        textInput("txtInput","Enter scenario name"),
        textOutput("sname"),
        actionButton("save","save_scenario")
      )
    })
    output$sname <- renderText({ input$txtInput })

    observeEvent(input$save,{
      dd <- data.frame(x = input$txtInput,row.names = FALSE)
      print(dd)
      dbWriteTable(pool,"available_scenario",dd,append = TRUE)

      # 保存成功后，立即更新下拉列表选项
      latest_choices <- get_latest_scenarios()
      updateSelectInput(
        session, 
        "n", 
        choices = latest_choices, 
        selected = input$n # 保留用户之前的选中项，提升体验
      )
    })
  })

  # 原有代码保持不变
  output$tabs = renderUI({
    if(!is.null(input$n)){
      Tabs <- lapply(paste("tab name:", input$n, sep=" "), tabPanel)
      do.call(tabsetPanel, Tabs)}
  })

  observeEvent(input$load_scenario,{
    output$inputs <- renderUI({
      dashboardPage(
        dashboardHeader(title = "Basic dashboard"),
        dashboardSidebar(),
        dashboardBody(
          fluidRow(
            box(plotOutput("plot1", height = 250)),
            box(
              title = "Controls",
              sliderInput("slider", "Number of observations:", 1, 100, 50)
            )))
    } )
    histdata <- rnorm(500)
    output$plot1 <- renderPlot({
      data <- histdata[seq_len(input$slider)]
      hist(data)
    })
  })
}

关键改动说明： #

• 新增get_latest_scenarios函数，专门负责从数据库拉取最新场景列表，避免代码重复。
• 用updateSelectInput直接更新下拉框选项，无需重新渲染整个组件，响应更快。
• 保留selected = input$n参数，让用户之前选中的场景不会因为更新而丢失，体验更流畅。

这样修改后，你创建新场景并保存后，不需要刷新浏览器，下拉列表会自动显示新增的场景，完全不需要重启服务器。

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