R Shiny : How can I return reactive values from a shiny module to the master server function?

Question

我有一个简单的玩具示例，它使用 add/removeBtn 模块从“第一个”模块添加和删除 UI。我需要跟踪单击添加/删除的次数。如果我不使用模块，这很容易，但我试图在嵌套模块的上下文中执行此操作。代码如下，但基本上，我似乎无法访问主服务器函数中 addRmBtnServer() 的返回值。我确信这是一个简单的修复，但我已经尝试了很多方法来解决这个问题，但似乎无法通过调用 addRmBtnServer() 访问结果。谢谢!

library(shiny)

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

firstServer <- function(input, output, session, a) {

    output$first <- renderUI({
        selectInput(session$ns("select"), h4("Select"), paste0(isolate(a()),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
    })

    return(params$btn)
}

ui <- fluidPage(
          addRmBtnUI("addRm"),
          textInput("a", label = "a", value = 1, width = '150px'),
          verbatimTextOutput("view", placeholder = TRUE)
          )

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

    pars <- callModule(
    addRmBtnServer, id = "addRm",
    moduleToReplicate = list(
      ui = firstUI,
      server = firstServer,
      remover = removeFirstUI
        ), 
    )

    output$view <- renderText({ pars() })

}

shinyApp(ui = ui, server = server)

Answer 1

正如评论中所说，您可以将值作为返回值传递给相应的服务器函数。下面有一个工作示例。我遗漏了 firstUI , firstServer和 removeFirstUI实现，因为它们与您的问题无关。

library(shiny)

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

  return(reactive({params$btn}))
}

ui <- fluidPage(
  addRmBtnUI("addRm"),
  verbatimTextOutput("view", placeholder = TRUE)
)

server <- function(input, output, session) {
  a <- reactive({input$a})

  pars <- callModule(
    addRmBtnServer, id = "addRm",
    moduleToReplicate = list(
      ui = function(...){},
      server = function(...){},
      remover = function(...){}
    )
  )
  output$view <- renderText({ pars() })
}

shinyApp(ui = ui, server = server)