R Shiny:如何将闪亮模块的无功值返回到主服务器功能?

时间:2017-10-05 23:24:50

标签: r shiny

我有一个简单的玩具示例,它使用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)

1 个答案:

答案 0 :(得分:4)

如评论中所述,您可以将值作为返回值传递到相应的服务器函数中。下面有一个工作示例。我遗漏了firstUIfirstServerremoveFirstUI实施,因为它们与您的问题无关。

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)