Dinamik olarak oluşturulmuş Shiny modüllerinin döndürülen değerlerine erişin

Aug 18 2020

Basit bir form döndüren dinamik olarak modüller (callmodule aracılığıyla) oluşturan parlak bir uygulama oluşturmak istiyorum. Bu konuda biraz rehberlik yapmaktan memnun olacağım 2 eksik sonum var.

İlk olarak, kullanıcıya birden çok form getirildiğinde (bir düğme tıklamasıyla), önceden oluşturulmuş formlardaki değerler varsayılana geri döner. Değerlerin kullanıcı seçiminde kalması için bu davranışı nasıl durdururum?

Ve 2, seçimlerdeki 'tüm' değerlere tableOutput'ta gösterilebilecek tek bir tibble'da nasıl erişebilir ve sunabilirim? ObserveEvent kullanarak aşağıda basit bir örnek oluşturdum; Ayrıca eventReactive ile bir varyasyon denedim ancak callmodule çıkışlarına erişemiyorum.

Thnx önceden!

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)

Yanıtlar

1 starja Aug 18 2020 at 04:37

İşte kullanan bir çözüm insertUI. Mevcut UI öğelerinin aynı kalması (önceki modüllerin sıfırlanmaması) ve yalnızca yeni modüllerin eklenmesi avantajına sahiptir. Kullanıcı arayüzünün nereye eklendiğini belirlemek tags$div(id = "tag_that_determines_the_position")için UIişlevde bir tanımlayın . Sonra insertUIbunu bir argüman olarak alır. Ek olarak, birkaç şeyi değiştirdim:

  • modül sunucu işlevi kodunu basitleştirdiğinden, temelde yalnızca bir reactive
  • parlak 1.5.0 ile sunulan yeni modül arayüzünün kullanımı
  • biraz daha basit reaktif veri yapısı kullanın (daha az iç içe geçme)
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

Bence böyle bir şey istiyorsun

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

Tüm reaktif model öğelerini içinde gen_forms$all_form_valuestopladınız , böylece bunların üzerinde yinelersiniz ve reaktif değeri alırsınız ve ardından tüm bu tabloları birbirine bağlarsınız.