r - 嵌套 callModules 的 Shiny 命名空间问题

Question

我正在寻求有关模块化设计的简单 Shiny 应用程序的帮助。我认为问题是 namespace 问题，因此下面的示例是我实际项目的简化版本。我的感觉是我没有设置output$uis到正确的 namespace ，但我不知道如何映射到它。
该应用程序生成 select_formUI 的 3 个实例并且应该是与来自 callModules 的服务器返回值的 3 个实例相关的命名空间的 select_form .来自 select_form 的值被传递出去。内部模块将所有 3 个 tibble 绑定(bind)为一个 react 性 tibble all_gen_forms_rctv .
该过程运行良好，直到我取消注释 input_slt_type_db栏目pass_back_test ，返回 input$slt_type_db .我正在寻找一些帮助，请将此列包含在输出中，然后查看 all_gen_forms_rctv通过 output$outpt_test 更改用户选择.

library(shiny)
library(shinyjs)
library(glue)
library(tibble)

select_formUI <- function(id){
  ns <- NS(id)
  tagList(selectInput(ns('slt_type_db'), 'select letter', choices = letters[1:5]))
}

select_form  <- function(input, output, session){
  #pass_back_test <- reactive({
    tibble(
      placehold =  "FILL VALUE"
      # , input_slt_type_db = input$slt_type_db
    )
  })
  return(list(pass_back_test = reactive({pass_back_test()})))
}

inner_moduleUI <- function(id){
  ns <- NS(id)
  tagList(uiOutput(ns("outpt_forms_ui")))
}



inner_module <- function(input, output, session){
  
  rctval_ui <- reactiveValues(all_ui=NULL)
  gen_forms <- reactiveValues()
  
  all_gen_forms_rctv <- reactive({
    
    dplyr::bind_rows(lapply(reactiveValuesToList(gen_forms), function(current_module_output) {
      current_module_output$pass_back_test()
    }))
  })
  
  observeEvent(input$btn_start ,{
    
    for(i in 1:3){
      x_id = glue("mod_{i}")
      rctval_ui$all_ui[[x_id]] <- select_formUI(x_id)
      gen_forms[[x_id]] <- callModule(select_form, x_id)
    }
  })
  
  output$outpt_forms_ui <- renderUI({
    ns <- session$ns
    tagList(
      actionButton(ns('btn_start'), label = 'start'),
      verbatimTextOutput(ns('outpt_test')),
      hr(),
      uiOutput(ns('uis'))
    )
  })
  
  output$uis <- renderUI({
    ns <- session$ns
    tags$div(id = environment(ns)[['namespace']],
    tagList(rctval_ui$all_ui))
    })
  
  output$outpt_test <- renderPrint({all_gen_forms_rctv()})
  
}

ui <- fluidPage(
  useShinyjs(),
  uiOutput('main_ui')
)

server <- function(input, output, session) {
  
  output$main_ui <- renderUI({inner_moduleUI('inner_ns')})
  callModule(inner_module, 'inner_ns')
  
}

shinyApp(ui = ui, server = server)

Answer 1

问题是 select_form 模块的 UI 函数不知道它正在另一个模块中调用。所以你需要通过将 id 包裹在 session$ns 中来告诉它. callModule函数可以自己处理这个，所以这里不需要改变任何东西。 inner_module 功能看起来像这样

inner_module <- function(input, output, session) {
  
  rctval_ui <- reactiveValues(all_ui=NULL)
  gen_forms <- reactiveValues()
  
  all_gen_forms_rctv <- reactive({
    browser()
    dplyr::bind_rows(lapply(reactiveValuesToList(gen_forms), function(current_module_output) {
      current_module_output$pass_back_test()
    }))
  })
  
  observeEvent(input$btn_start ,{
    
    for(i in 1:3){
      x_id = glue("mod_{i}")
      rctval_ui$all_ui[[x_id]] <- select_formUI(session$ns(x_id))
      gen_forms[[x_id]] <- callModule(select_form, x_id)
    }
  })
  
  output$outpt_forms_ui <- renderUI({
    ns <- session$ns
    tagList(
      actionButton(ns('btn_start'), label = 'start'),
      verbatimTextOutput(ns('outpt_test')),
      hr(),
      uiOutput(ns('uis'))
    )
  })
  
  output$uis <- renderUI({
    ns <- session$ns
    tags$div(id = environment(ns)[['namespace']],
             tagList(rctval_ui$all_ui))
  })
  
  output$outpt_test <- renderPrint({all_gen_forms_rctv()})
  
}