Access the returned values of dynamically created Shiny modules

user_3193927 0
Viewed 197

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)
shiny r
2 Answers

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)
user_126473150

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.

user_23720640
Related