我正在寻找一个闪亮的应用程序，该应用程序动态创建模块（通过callmodule），该模块返回一个简单的表单。我对此有2个宽松的结论，请多多指教。
首先，当将多个表单（通过单击按钮）带给用户时，先前呈现的表单上的值将恢复为默认值。如何停止这种行为，使值保留在用户的选择上？
以及2，如何访问所选内容中的“所有”值并将其呈现为一个可以在tableOutput中显示的小标题？我在下面使用observeEvent组合了一个简单的示例；我也尝试使用eventReactive进行变体，但是似乎无法访问callmodule输出。
提前thnx！
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)
这是使用的解决方案insertUI。其优点是现有的UI元素保持不变（无需重置先前的模块），而仅添加新的模块。要确定UI的添加位置，请tags$div(id = "tag_that_determines_the_position")在UI函数中定义a 。然后，insertUI以此为参数。此外，我还做了一些更改：
reactivelibrary(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)
本文收集自互联网，转载请注明来源。
如有侵权，请联系 [email protected] 删除。
我来说两句