R Shiny：如何將閃亮模塊的無功值返回到主服務器功能？

Question

我有一個簡單的玩具示例，它使用add / removeBtn模塊在“first”模塊中添加和刪除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)