Akses nilai yang dikembalikan dari modul Shiny yang dibuat secara dinamis

Aug 18 2020

Saya ingin membangun aplikasi mengkilap yang secara dinamis membuat modul (melalui callmodule) yang mengembalikan bentuk sederhana. Saya memiliki 2 ujung longgar di atasnya yang saya akan menghargai beberapa panduan.

Pertama, ketika beberapa formulir dibawa ke pengguna (melalui klik tombol), nilai pada formulir yang diberikan sebelumnya kembali ke default. Bagaimana cara menghentikan perilaku ini sehingga nilai tetap pada pilihan pengguna?

Dan 2, bagaimana cara mengakses dan menyajikan 'semua' nilai dari pilihan ke dalam satu tibble yang dapat ditampilkan di tableOutput? Saya telah membuat contoh sederhana bersama di bawah ini menggunakan observEvent; Saya juga mencoba variasi dengan eventReactive namun saya sepertinya tidak bisa mengakses output callmodule.

Terima kasih sebelumnya!

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)

Jawaban

1 starja Aug 18 2020 at 04:37

Berikut adalah solusi yang digunakan insertUI. Ini memiliki keuntungan bahwa elemen UI yang ada tetap sama (tidak ada pengaturan ulang dari modul sebelumnya) dan hanya modul baru yang ditambahkan. Untuk menentukan di mana UI ditambahkan, tentukan a tags$div(id = "tag_that_determines_the_position")dalam UIfungsi. Kemudian, insertUIanggap ini sebagai argumen. Selain itu, saya telah mengubah beberapa hal:

  • menyederhanakan kode untuk fungsi server modul, pada dasarnya Anda hanya perlu file reactive
  • penggunaan antarmuka modul baru yang diperkenalkan dengan Shiny 1.5.0
  • menggunakan struktur data reaktif yang sedikit lebih sederhana (lebih sedikit bersarang)
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

Saya pikir Anda menginginkan sesuatu seperti ini

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

Anda telah mengumpulkan semua elemen reaktif model gen_forms$all_form_valuessehingga Anda mengulanginya dan mendapatkan nilai reaktif, lalu mengikat semua tabel tersebut menjadi satu.