Accéder aux valeurs renvoyées des modules Shiny créés dynamiquement

Aug 18 2020

Je cherche à créer une application brillante qui crée dynamiquement des modules (via callmodule) qui retourne un formulaire simple. J'ai 2 bouts à ce sujet sur lesquels j'apprécierais quelques conseils s'il vous plaît.

Premièrement, lorsque plusieurs formulaires sont amenés à l'utilisateur (via un clic sur un bouton), les valeurs des formulaires précédemment rendus reviennent à la valeur par défaut. Comment arrêter ce comportement afin que les valeurs restent sur la sélection des utilisateurs?

Et 2, comment puis-je accéder et présenter «toutes» les valeurs des sélections dans un seul tibble qui peut être affiché dans un tableauOutput? J'ai mis un exemple simple ensemble ci-dessous en utilisant observerEvent; J'ai également essayé une variante avec eventReactive, mais je n'arrive tout simplement pas à accéder aux sorties du module d'appel.

Thnx à l'avance!

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)

Réponses

1 starja Aug 18 2020 at 04:37

Voici une solution qui utilise insertUI. Il présente l'avantage que les éléments d'interface utilisateur existants restent les mêmes (pas de réinitialisation des modules précédents) et que seuls de nouveaux modules sont ajoutés. Pour déterminer où l'interface utilisateur est ajoutée, définissez un tags$div(id = "tag_that_determines_the_position")dans la UIfonction. Ensuite, insertUIprend cela comme un argument. De plus, j'ai changé quelques choses:

  • simplifié le code de la fonction de serveur de module, vous n'avez besoin que d'un reactive
  • utilisation de la nouvelle interface de module introduite avec shiny 1.5.0
  • utiliser une structure de données réactive un peu plus simple (moins d'imbrication)
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

Je pense que tu veux quelque chose comme ça

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

Vous avez rassemblé tous les éléments réactifs du modèle gen_forms$all_form_valuesafin de les parcourir et d'obtenir la valeur réactive, puis de lier toutes ces tables ensemble.