Dinamik olarak oluşturulmuş Shiny modüllerinin döndürülen değerlerine erişin
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
İş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 UI
işlevde bir tanımlayın . Sonra insertUI
bunu 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)
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_values
topladı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.