如何将R Shiny的加载功能移入模态对话框？

我已经实现了矩阵输入的保存、加载和删除功能用于场景保存，现在希望把**加载（将已保存场景数据载入矩阵）**功能移入modify按钮触发的模态对话框中，让界面更整洁。掌握方法后我会对保存和删除功能执行同样操作。

示例效果：

原代码如下：

library(shiny)
library(shinyjs)
library(shinyMatrix)

ui <- fluidPage(
  useShinyjs(),
  h5(strong("Matrix inputs:")),
  matrixInput(
    "base_input", 
    value = matrix(rep(1,2), 2, 1, dimnames = list(c("A","B"),NULL)),
    rows = list(extend = FALSE,  names = TRUE),
    cols = list(extend = FALSE, names = FALSE, editableNames = FALSE),
    class = "numeric"
  ),
  
  h5(strong("Manipulate matrix inputs and output as dataframe:")),
  tableOutput("result_table"),
  
  h5(strong("Save, Load, and Delete User Inputs:")),
  textInput("save_name", "Save As:"),
  actionButton("save_btn", "Save"),
  br(),br(),
  actionButton('modify','Load saved inputs'),
  
  selectInput("load_input", "Load Saved Inputs:", ""),
  actionButton("load_btn", "Load"),
  
  selectInput("delete_input", "Delete Saved Inputs:", ""),
  actionButton("delete_btn", "Delete"),
  
  hidden(downloadButton("save_file", "Download Saved Input")),
  hidden(downloadButton("load_file", "Download Loaded Input"))
)

server <- function(input, output, session)({
  observeEvent(input$save_btn, {
    name <- input$save_name
    values <- input$base_input
    saveRDS(values, paste0(name, ".rds"))
  })
  
  observe({
    saved_files <- list.files(pattern = "\\.rds$")
    updateSelectInput(session, "load_input", choices = saved_files)
    updateSelectInput(session, "delete_input", choices = saved_files)
  })
  
  observeEvent(input$modify,{
    showModal(modalDialog(
      h5("Would like to move the load section here...")
    )) 
  }) 
  
  observeEvent(input$load_btn, {
    file <- input$load_input
    if (file.exists(file)) {
      loaded_values <- readRDS(file)
      updateMatrixInput(session, "base_input", value = loaded_values)
    }
  })
  
  observeEvent(input$delete_btn, {
    file <- input$delete_input
    if (file.exists(file)) {
      unlink(file)
    }
  })
  
  matrix_data <- reactive({
    matrix_df <- as.data.frame(
      matrix(
        input$base_input * 4, 2, 1, dimnames = list(c("A","B"), NULL)
      )
    )
    colnames(matrix_df) <- "Matrix x 4"
    matrix_df
  })
  
  output$result_table <- renderTable({
    matrix_data()
  }, rownames = TRUE, colnames = TRUE)
  
  output$save_file <- downloadHandler(
    filename = function() {
      paste0(input$save_name, ".rds")
    },
    content = function(file) {
      saveRDS(input$base_input, file)
    }
  })
  
  output$load_file <- downloadHandler(
    filename = function() {
      input$load_input
    },
    content = function(file) {
      file.copy(input$load_input, file)
    }
  })
})

shinyApp(ui, server)

步骤1：调整UI结构 #

• 移除原UI中单独的load_input下拉框和load_btn按钮（或用hidden()隐藏避免冗余）
• 在modify按钮触发的模态框内部添加加载所需的下拉选择和按钮

步骤2：完善模态框内容 #

在showModal的modalDialog里添加加载功能控件，同时保证模态框每次打开时能获取最新的已保存文件列表。

步骤3：调整Server逻辑 #

• 确保模态框内的下拉框能实时更新已保存文件
• 保留原加载功能核心逻辑，绑定到模态框内的按钮

修改后的完整代码 #

library(shiny)
library(shinyjs)
library(shinyMatrix)

ui <- fluidPage(
  useShinyjs(),
  h5(strong("Matrix inputs:")),
  matrixInput(
    "base_input", 
    value = matrix(rep(1,2), 2, 1, dimnames = list(c("A","B"),NULL)),
    rows = list(extend = FALSE,  names = TRUE),
    cols = list(extend = FALSE, names = FALSE, editableNames = FALSE),
    class = "numeric"
  ),
  
  h5(strong("Manipulate matrix inputs and output as dataframe:")),
  tableOutput("result_table"),
  
  h5(strong("Save, Load, and Delete User Inputs:")),
  textInput("save_name", "Save As:"),
  actionButton("save_btn", "Save"),
  br(),br(),
  actionButton('modify','Load saved inputs'),
  
  # 移除原加载控件（或用hidden()隐藏）
  # hidden(selectInput("load_input", "Load Saved Inputs:", "")),
  # hidden(actionButton("load_btn", "Load")),
  
  selectInput("delete_input", "Delete Saved Inputs:", ""),
  actionButton("delete_btn", "Delete"),
  
  hidden(downloadButton("save_file", "Download Saved Input")),
  hidden(downloadButton("load_file", "Download Loaded Input"))
)

server <- function(input, output, session)({
  observeEvent(input$save_btn, {
    name <- input$save_name
    values <- input$base_input
    saveRDS(values, paste0(name, ".rds"))
  })
  
  # 监听已保存文件变化，更新所有相关下拉框
  observe({
    saved_files <- list.files(pattern = "\\.rds$")
    updateSelectInput(session, "delete_input", choices = saved_files)
    # 若模态框已打开，同步更新模态框内的加载下拉框
    if (!is.null(input$modal_load_input)) {
      updateSelectInput(session, "modal_load_input", choices = saved_files)
    }
  })
  
  observeEvent(input$modify,{
    # 初始化模态框时获取最新已保存文件
    saved_files <- list.files(pattern = "\\.rds$")
    showModal(modalDialog(
      title = "加载已保存场景",
      selectInput("modal_load_input", "选择要加载的场景:", choices = saved_files),
      actionButton("modal_load_btn", "加载"),
      easyClose = TRUE,
      footer = NULL
    )) 
  }) 
  
  # 模态框内加载按钮的逻辑
  observeEvent(input$modal_load_btn, {
    file <- input$modal_load_input
    if (file.exists(file)) {
      loaded_values <- readRDS(file)
      updateMatrixInput(session, "base_input", value = loaded_values)
      # 加载完成后自动关闭模态框
      removeModal()
    }
  })
  
  observeEvent(input$delete_btn, {
    file <- input$delete_input
    if (file.exists(file)) {
      unlink(file)
    }
  })
  
  matrix_data <- reactive({
    matrix_df <- as.data.frame(
      matrix(
        input$base_input * 4, 2, 1, dimnames = list(c("A","B"), NULL)
      )
    )
    colnames(matrix_df) <- "Matrix x 4"
    matrix_df
  })
  
  output$result_table <- renderTable({
    matrix_data()
  }, rownames = TRUE, colnames = TRUE)
  
  output$save_file <- downloadHandler(
    filename = function() {
      paste0(input$save_name, ".rds")
    },
    content = function(file) {
      saveRDS(input$base_input, file)
    }
  })
  
  output$load_file <- downloadHandler(
    filename = function() {
      input$modal_load_input # 适配模态框内的输入ID
    },
    content = function(file) {
      file.copy(input$modal_load_input, file)
    }
  })
})

shinyApp(ui, server)

关键修改点说明 #

1. 控件独立命名：给模态框内的下拉框和按钮单独命名（如modal_load_input、modal_load_btn），避免与原控件冲突
2. 实时同步列表：在监听已保存文件变化的observe中，同步更新模态框内的下拉框（判断模态框是否已打开）
3. 优化用户体验：加载完成后自动关闭模态框
4. 适配关联功能：将下载加载输入的逻辑改为使用模态框内的输入ID

按照这个思路，你可以将保存、删除功能也移入各自的模态框：

• 创建对应的触发按钮
• 在模态框内添加所需输入控件（如保存功能需输入文件名）
• 将原保存/删除逻辑绑定到模态框内的按钮上

内容的提问来源于stack exchange，提问作者Village.Idyot