我正在尝试根据用户输入创建动态 UI。首先，我使用lapply内部 Mod2.R 将 Mod1 的值返回到 Mod2 并将其保存在一个reactiveVal对象中，该对象位于 mod2.R 内部并保存为binner_step_data. 然后，主应用程序还会lapply对 Mod2.R（取决于 Mod1.R）的返回值进行操作，并将其保存在一个reactiveVal对象中，该对象另存为binner_data.
模组1.R
mod1_UI <- function(id) {
ns <- NS(id)
tagList(
fluidRow(
column(
width = 6,
selectInput(ns("sel_step_name"), "Step Name", choices = c("step1", "step2"))
) # Column
,
column(
width = 3,
numericInput(ns("num_threshold"), "Threshold", value = 0)
) # Column
) # Row
) # tag list
}
mod1_Server <- function(input, output, session) {
return(
list(
step_name = reactive({input$sel_step_name}),
threshold = reactive({input$num_threshold})
)
)
}
模组2.R
mod2_UI <- function(id) {
ns <- NS(id)
tagList(
fluidRow(
column(
width = 12,
selectInput(ns("sel_n_steps"), "Number of Steps", selected = NULL, choices = 1:3),
uiOutput(ns("ui_mod1_steps"))
)
),
fluidRow(
column(
width = 12,
textInput(ns("txt_bin_name"), "Bin Name", placeholder = "Name of Bin e.g., Blocker", value = "**")
) # Column
) # Fluid Row
) # tag list
}
mod2_Server <- function(input, output, session) {
ns <- session$ns
binner_step_data <- reactiveVal()
observeEvent(input$sel_n_steps{
req(input$sel_n_steps)
lapply(
1:input$sel_n_steps,
function(i) {
res <- callModule(mod1_Server, paste0("binner_step", i), binner_number = reactive(i), dat = reactive(dat()))
return(res)
}
) %>% binner_step_data(.)
})
output$ui_mod1_steps <- renderUI({
req(input$sel_n_steps)
tagList(
fluidRow(
column(
width = 12,
lapply(
1:as.numeric(input$sel_n_steps),
function(i) {
mod1_UI(ns(paste0("binner_step_", i)))
}
) # lapply
) # Column
) # Fluid Row
) # Tag List
})
return(
list(
bin_name = reactive({input$txt_bin_name}),
bin_criteria = reactive({lapply(binner_step_data(), function(step_data) { step_data() })})
)
)
}
这是我的前两个模块，其中 Mod2.R 使用 Mod1.R 的返回值。现在这是使用 Mod2.R 的返回值的主 app.R 文件。
应用程序.R
library(shiny)
library(tidyverse)
# Modules
source("Mod1.R")
source("Mod2.R")
ui <- fluidPage(
fluidRow(
column(
width = 12,
numericInput("num_bins", "Number of Bins", value = NULL, min = 1, max = 10)
) # Column
) # Fluid Row
,
fluidRow(
column(
width = 12,
uiOutput("ui_binners")
) # Column
), # FLuid Row
fluidRow(
column(
width = 12,
verbatimTextOutput("reactive_output_from_mod2")
)
)
)
server <- function(input, output, session) {
binner_data <- reactiveVal()
# Modules -----------------------------------------------------------------
observeEvent(input$num_bins, {
req(input$num_bins)
lapply(
1:input$num_bins,
function(i) {
res <- callModule(mod2_Server, paste0("binner_", i))
return(res)
}
) %>% binner_data(.)
})
output$ui_binners <- renderUI({
req(input$num_bins)
tagList(
fluidRow(
column(
width = 12,
lapply(
1:input$num_bins,
function(i) {
mod2_UI(paste0("binner_", i))
}
) # lapply
) # Column
) # Fluid Row
) # Tag List
})
output$reactive_output_from_mod2 <- renderPrint({
# req(input$sel_n_steps)
binner_data()
})
}
shinyApp(ui, server)
最后，我使用 renderPrint 来确认我需要的值正在传递到主服务器，但显然它们不是。我应该返回一个包含两个的列表，第一个元素是 Bin 名称，第二个元素是 Bin Criteria（步骤名称 + 阈值）。处理来自两个模块的返回值以取回我需要的数据的最佳方法是什么？谢谢。
