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

如何解决访问动态创建的Shiny模块的返回值

我正在寻找一个闪亮的应用程序，该应用程序可以动态创建模块（通过callmodule），该模块返回简单的表单。我对此有2个松懈的结论，请多多指教。

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

然后2，如何访问所选内容中的“所有”值并将其显示为一个小标题，可以在tableOutput中显示？ 我在下面使用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")),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")函数中定义一个UI。然后，insertUI将此作为参数。此外，我还做了一些更改：

• 简化了模块服务器功能的代码，基本上您只需要一个reactive
• 使用闪亮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")),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)

,

我想你想要这样的东西

  all_form_values_rctv <- reactive({
    dplyr::bind_rows(lapply(gen_forms$all_form_values,function(x) {
      x$select_values_all()
    }))
  })

您已经收集了gen_forms$all_form_values中的所有模型反应性元素，因此可以对它们进行迭代并获得反应性值，然后将所有这些表绑定在一起。