Acesse os valores retornados de módulos Shiny criados dinamicamente

Aug 18 2020

Estou procurando construir um aplicativo brilhante que cria módulos dinamicamente (via callmodule) que retorna um formulário simples. Tenho duas pontas soltas sobre as quais gostaria de receber alguma orientação.

Em primeiro lugar, quando vários formulários são trazidos para o usuário (por meio de um clique de botão), os valores nos formulários renderizados anteriormente voltam ao padrão. Como faço para parar esse comportamento para que os valores permaneçam na seleção do usuário?

E 2, como faço para acessar e apresentar 'todos' os valores das seleções em uma única tabela que pode ser mostrada em um tableOutput? Eu coloquei um exemplo simples abaixo usando observeEvent; Eu também tentei uma variação com eventReactive, mas simplesmente não consigo acessar as saídas do módulo de chamada.

Thnx antecipadamente!

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)

Respostas

1 starja Aug 18 2020 at 04:37

Aqui está uma solução que usa insertUI. Tem a vantagem de que os elementos da interface do usuário existentes permanecem os mesmos (sem reinicialização dos módulos anteriores) e apenas novos módulos são adicionados. Para determinar onde a IU é adicionada, defina um tags$div(id = "tag_that_determines_the_position")na UIfunção. Então, insertUItoma isso como um argumento. Além disso, mudei algumas coisas:

  • simplificou o código para a função de servidor de módulo, você basicamente só precisa de um reactive
  • uso da nova interface do módulo introduzida no brilhante 1.5.0
  • use uma estrutura de dados reativa um pouco mais simples (menos aninhamento)
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)
MrFlick Aug 18 2020 at 03:56

Eu acho que você quer algo assim

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

Você coletou todos os elementos reativos do modelo, gen_forms$all_form_valuespara iterar sobre eles e obter o valor reativo e, em seguida, vincular todas essas tabelas.