Access the returned values of dynamically created Shiny modules

问题

I am looking to build a shiny app that dynamically creates modules (via callmodule) that returns a simple form. I have 2 loose ends on it that I would appreciate some guidance on please.

Firstly, when multiple forms are brought to the user (via a button click), the values on previously rendered forms revert to the default. How do I stop this behaviour so that values stay on the users selection?

And 2, how do I access and present ‘all’ the values from the selections into a single tibble that can be shown in a tableOutput? I have put a simple example together below using observeEvent; I also tried a variation with eventReactive however I just can’t seem to access the callmodule outputs.

Thnx in advance!

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)

回答1:

Here is a solution that uses insertUI. It has the advantage that existing UI elements stay the same (no resetting of the previous modules) and only new modules are added. To determine where the UI is added, define a tags$div(id = "tag_that_determines_the_position") in the UI function. Then, insertUI takes this as an argument. Additionally, I've changed a few things:

simplified the code for the module server function, you basically only need a reactive
use of the new module interface introduced with shiny 1.5.0
use a bit simpler reactive data structure (less nesting)

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)

回答2:

I think you want something like this

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

You've collected all the model reactive elements in gen_forms$all_form_values so you iterate over them and get the reactive value and then bind all those tables together.

来源：https://stackoverflow.com/questions/63457730/access-the-returned-values-of-dynamically-created-shiny-modules

标签

Shiny