R Shiny：如何将模块作为参数传递给其他模块，并将这些模块称为新模块

Question

我正在尝试分解我创建的一个笨重的应用程序，并且在这样做时我意识到我确实需要模块化添加/删除按钮。我希望能够创建一个具有添加和删除按钮的闪亮模块，通过单击这些按钮，我们可以添加和删除另一个模块的实例。为了简单起见，我有一个玩具示例，它有一个简单的模块，只有一个 selectInput() IU 和 3 个选项。我希望能够根据需要添加尽可能多的这些 selectInput() UI 元素，并能够访问这些选择的结果以在主服务器逻辑中使用。所以我创建了“firstUI()”和firstServer()模块，以及“addRmBtnUI()”和“addRmBtnServer()”模块。addRmBtn模块接受参数serverModToCall和uiModToCall，它们是ui和server模块的名称我们想用 addRmBtn 模块调用。我似乎在将这些模块作为参数传递给 addRmBtn 模块时被绊倒了。代码如下。我怎样才能让它按预期工作？谢谢！

suppressWarnings(library(shiny))


firstUI <- function(id) {
    ns <- NS(id)

    tags$div(
        fluidRow(
            column(12,
                uiOutput(ns("first"))
                )
            )
        )
}

firstServer <- function(input, output, session) {
    ns = session$ns

    output$first <- renderUI({
        selectInput(ns("select"), label = h4("Select"),
                choices = list("Selection1" = 1, "Selection2" = 2,
                "Selection3" = 3), selected = 1)
    })
}

addRmBtnUI <- function(id) {
    ns <- NS(id)

    tags$div(
        fluidRow(
            column(2,
                uiOutput(ns("insertParamBtn"))
            ),
            column(2,
                uiOutput(ns("removeParamBtn"))
                )
            ),
    hr(),
    tags$div(id = 'placeholder')
        )

}

addRmBtnServer <- function(input, output, session, serverModToCall, uiModToCall) {
    ns = session$ns

    params <- reactiveValues(btn = 0)

    output$insertParamBtn <- renderUI({
        actionButton(inputId = ns('insertParamBtn'),
            label = "Add", offset = 3)
    })

    output$removeParamBtn <- renderUI({
        actionButton(inputId = ns('removeParamBtn'),
            label = "Remove", offset = 3)
    })

    params <- reactiveValues(btn = 0)

    observeEvent(input$insertParamBtn, {
        params$btn <- params$btn + 1
        callModule(do.call(serverModToCall, args = list(id = params$btn)))
        insertUI(
                selector = '#placeholder',
                ui = do.call(uiModToCall, args = list(id = params$btn))  #********# This line is issue
                )
    })

    observeEvent(input$removeParamBtn, {
    removeUI(
    ## pass in appropriate div id
            selector = paste0('#param', params$btn)
            )
    params$btn <- params$btn - 1
    })
}

ui <- function(request) {
    fluidPage(
        fluidRow(
           addRmBtnUI(1)
           ),
       fluidRow(
           uiOutput("result")
           )
       )
}

server <- function(input, output, session) {


    callModule(addRmBtnServer, id = 1,
        serverModToCall = 'firstServer',
        uiModToCall = 'firstUI')
    res <- reactive({  })

    output$result <- renderUI({
        verbatimTextOutput(paste0(input[[NS(1, "select")]]), placeholder = T)
        })
}

shinyApp(ui = ui, server = server)

Answer 1

代码中似乎有一些错误

首先，对firstServer的调用是

callModule(do.call(firstServer, args = list(id = params$btn)))

翻译成

callModule(firstServer(params$btn))

callModule 应该像这样调用：

callModule(firstServer, params$btn)

以下版本传递函数而不是函数名称，因此乍一看可能很难发现差异。

其次，您需要为insertUI/removeUI 命名空间。您可以在this article 的“嵌套模块”部分阅读更多相关信息。

## in addRmBtnServer/observe add button
insertUI(
  selector = paste('#', ns('placeholder')),
  ui = uiModToCall(ns(params$btn))
)

## in addRmBtnServer/observe remove button
removeFirstUI(ns(params$btn))

## in global scope
removeFirstUI <- function(id){
  removeUI(selector = paste0('#', NS(id, "first") ))
}

第三，我不确定output$result应该显示什么，所以我在下面的版本中省略了它。

library(shiny)

firstUI <- function(id){uiOutput(NS(id, "first"))}

firstServer <- function(input, output, session){
  output$first <- renderUI({
    selectInput(session$ns("select"), h4("Select"), letters[1:4])
  })
}

removeFirstUI <- function(id){
  removeUI(selector = paste0('#', NS(id, "first")))
}

addRmBtnUI <- function(id) {
  ns <- NS(id)

  tags$div(
    actionButton(inputId = ns('insertParamBtn'), label = "Add"),
    actionButton(ns('removeParamBtn'), label = "Remove"),
    hr(),
    tags$div(id = ns('placeholder'))
  )   
}

addRmBtnServer <- function(input, output, session, moduleToReplicate) {
  ns = session$ns

  params <- reactiveValues(btn = 0)

  observeEvent(input$insertParamBtn, {
    params$btn <- params$btn + 1

    callModule(moduleToReplicate$server, id = params$btn)
    insertUI(
      selector = paste0('#', ns('placeholder')),
      ui = moduleToReplicate$ui(ns(params$btn))
    )
  })

  observeEvent(input$removeParamBtn, {
    moduleToReplicate$remover(ns(params$btn))
    params$btn <- params$btn - 1
  })
}

ui <- fluidPage(addRmBtnUI("addRm"))

server <- function(input, output, session) {
  callModule(
    addRmBtnServer, id = "addRm",
    moduleToReplicate = list(
      ui = firstUI,
      server = firstServer,
      remover = removeFirstUI
    )
  )
}

shinyApp(ui = ui, server = server)