嵌套 callModules 的闪亮命名空间问题答案

【问题标题】：Shiny namespace issue with nested callModules嵌套 callModules 的闪亮命名空间问题
【发布时间】：2020-12-11 22:12:48
【问题描述】：

我正在寻求有关模块化设计的简单 Shiny 应用程序的帮助。我认为问题是名称空间问题，因此下面的示例是我实际项目的简化版本。我的感觉是我没有将output$uis 设置为正确的名称空间，但我不知道如何映射到它。

应用程序生成 3 个 select_formUI 实例，并且应该是与来自 select_form 的 callModules 的服务器返回值的 3 个实例相关的命名空间。 select_form 中的值在 tibble 中传递。内部模块将所有 3 个 tibble 绑定到一个响应式 tibble all_gen_forms_rctv。

在我取消注释pass_back_test 中的input_slt_type_db 列之前，该过程运行良好，这将返回input$slt_type_db。我正在寻求一些帮助，请将此列包含在输出中，并通过output$outpt_test查看all_gen_forms_rctv用户选择的更改。

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)

【问题讨论】：

标签： r shiny namespaces shinyjs

【解决方案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()})
  
}

【讨论】：