访问动态创建的 Shiny 模块的返回值

我正在寻找构建一个闪亮的应用程序，它动态创建返回简单表单的模块（通过 callmodule ）。我有两个未解决的问题，希望得到一些指导。

首先，当向用户提供多个表单（通过单击按钮）时，先前呈现的表单上的值将恢复为默认值。如何停止这种行为，以便值保留在用户的选择中？

2，如何访问并将选择中的“所有”值呈现到可以在 tableOutput 中显示的单个 tibble 中？ 我在下面使用observeEvent组合了一个简单的例子；我还尝试了 eventReactive 的变体，但我似乎无法访问 callmodule 输出。

提前致谢！

library(shiny)
library(stringr)


gen_r_8_formUI <- function(id){
  
  ns <- NS(id)
  
  tagList(fluidRow(column(width = 4, selectInput(ns("slt_forename"), 'forename', choices = unique(c("john", "paul", "george", "ringo")))),
          column(width = 4, selectInput(ns("slt_surname") , 'surname' , choices = unique(c("lennon", "mccartney", "harrison", "starr"))))))
}

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

  select_values <- reactiveValues(forename = NULL, surname = NULL)  
  observeEvent(input$slt_forename,{select_values$forename <- input$slt_forename})
  observeEvent(input$slt_surname, {select_values$surname  <- input$slt_surname})
  select_values_all <- reactive({tibble(forename  = select_values$forename, surname  = select_values$surname)})
  
  return(list(select_values_all = reactive({select_values_all()})))
}


ui <- fluidPage(
  column(width = 2, actionButton("btn_gen_r_8_form", "GEN R 8 a FORM")),
  column(width = 6, uiOutput("all_ui_forms")),
  column(width = 4, tableOutput("all_form_values_table")))

server <- function(input, output) {
  
  rctv_uis                     <- reactiveValues(all_ui          = list())
  gen_forms                    <- reactiveValues(all_form_values = list())
  output$all_ui_forms          <- renderUI({tagList(rctv_uis$all_ui)})
  output$all_form_values_table <- renderTable({all_form_values_rctv()})
  
  observeEvent(input$btn_gen_r_8_form, {
    
    x_id  <- paste( "ns_", str_replace_all(paste(Sys.time()), "-| |:", '') , sep = '')
    gen_forms$all_form_values[[x_id]] <- callModule(module = gen_r_8_form, id = x_id)
    rctv_uis$all_ui[[x_id]] <- gen_r_8_formUI(id = x_id)

  })
  
  
  all_form_values_rctv <- reactive({
    
    # Question - how to make a tibble with all form values?
    
    # tibble(
    #   forenames = 'all gen_forms$all_form_values forenames',
    #   surnames  = 'all gen_forms$all_form_values surnames'
    # )
    
  })
}

shinyApp(ui = ui, server = server)

这是一个使用的解决方案insertUI。它的优点是现有的 UI 元素保持不变（不重置以前的模块）并且仅添加新模块。要确定添加 UI 的位置，请定义tags$div(id = "tag_that_determines_the_position") in the UI功能。然后，insertUI以此为论据。此外，我还改变了一些事情：

• 简化了模块服务器功能的代码，你基本上只需要一个reactive
• 使用shiny 1.5.0引入的新模块接口
• 使用更简单的反应式数据结构（更少的嵌套）

library(shiny)
library(stringr)


gen_r_8_formUI <- function(id){
  
  ns <- NS(id)
  
  tagList(fluidRow(column(width = 4, selectInput(ns("slt_forename"), 'forename', choices = unique(c("john", "paul", "george", "ringo")))),
                   column(width = 4, selectInput(ns("slt_surname") , 'surname' , choices = unique(c("lennon", "mccartney", "harrison", "starr"))))))
}

gen_r_8_form <- function(id){
  moduleServer(
    id,
    function(input, output, session) {
      select_values_all <- reactive({tibble(forename  = input$slt_forename,
                                            surname  = input$slt_surname)})
      
      return(list(select_values_all = reactive({select_values_all()})))
    }
  )
}


ui <- fluidPage(
  column(width = 2, actionButton("btn_gen_r_8_form", "GEN R 8 a FORM")),
  column(width = 6, tags$div(id = "add_UI_here")),
  column(width = 4, tableOutput("all_form_values_table")))

server <- function(input, output) {
  gen_forms                    <- reactiveValues()
  current_id <- 1
  
  observeEvent(input$btn_gen_r_8_form, {
    x_id <- paste0("module_", current_id)
    
    gen_forms[[x_id]] <- gen_r_8_form(id = x_id)
    
    insertUI(selector = "#add_UI_here",
             ui = gen_r_8_formUI(x_id))
    
    current_id <<- current_id + 1
  })
  
  
  all_form_values_rctv <- reactive({
    res <- lapply(reactiveValuesToList(gen_forms), function(current_module_output) {
      current_module_output$select_values_all()
    })
    
    # prevent to show an error message when the first module is added
    if (length(res) != 0 && !is.null(res[[1]]$forename)) {
      dplyr::bind_rows(res)
    } else {
      NULL
    }
    
  })
  
  output$all_form_values_table <- renderTable({
    all_form_values_rctv()
  })
}

shinyApp(ui = ui, server = server)