Acesse os valores retornados de módulos Shiny criados dinamicamente
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
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 UI
função. Então, insertUI
toma 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)
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_values
para iterar sobre eles e obter o valor reativo e, em seguida, vincular todas essas tabelas.