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

Question

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

该应用程序生成了 select_formUI 的 3 个实例，并且应该与服务器从 select_form 的 callModules 返回值的 3 个实例相关的名称space。来自 select_form 的值以 tibble 形式传递。内部模块将所有 3 个 tibble 绑定到一个反应性 tibble all_gen_forms_rctv.

在我取消注释 pass_back_test 中的 input_slt_type_db 列之前，该过程工作正常，returns 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)

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()})
  
}

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

Shiny namespace issue with nested callModules

r

shiny

namespaces

shinyjs