R Shiny: Accessing reactive elements in nested shiny modules

Question

I have a nested set of shiny modules, where main UI takes a textInput() and calls an add/remove button module, which in turn calls a module called "first", which takes the textInput() value and prepends the choices in a selectInput() box consisting of "a", "b", "c", "d" as those choices. For example, if user types in "1" (default), the selectInput() box called by the add/remove button module would show choices as "1a", "1b", "qc", and "1d". I want to pass to the main server logic the result of the selectInput() box in "first" module. So I am passing the result of selectInput() as a return of "first" module, then assign it as reactive value in addRmBtn() module, and I would like to pass both that value and the param$btn value, which is the (net) number of times the add button was clicked. I am getting an error in the addRmBtnServer() module because I am not properly assigning the return of "first" module to reactive element in addRmBtnServer(). Code is below. Thanks!

library(shiny)

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

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

    output$first <- renderUI({
        selectInput(ns("select"), h4("Select"), paste0(isolate(a()), letters[1:4]))
    })

    return(reactive({ paste0(input$select) }))
}

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

       returnA <-  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({ c(returnA(), params$btn) }))
}

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

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


    a <- reactive({ input$a })
    comp <- callModule(
    addRmBtnServer, id = "addRm",
    moduleToReplicate = list(
      ui = firstUI,
      server = firstServer,
      remover = removeFirstUI
    ),
    a = a
  )
    output$output <- renderText({ paste("a = ", a(), "comp = ", comp()) })

}

shinyApp(ui = ui, server = server)

The problem is you assign returnA inside the observeEvent scope, so it is not accessible in addRmBtnServer . You can use params$returnA <- callModule(moduleToReplicate$server,...) instead. That works for me. — Gregor de Cillia

Gregor de Cillia Gregor de Cillia · Accepted Answer · 2017-10-06T15:28:49

Please try to give more minimalistic example codes in the future, if possible. Questions posted on SO are meant to help future visitors as well. If they have to go through 80-ish lines of code, that isn't very helpful for them. Also it makes your questions much harder to answer.

Anyways, I implemented the functionality you are after. The addRmButtonServer now returns a list of choices as well as the button value. All the values are stored in the param variable inside the addRmButtonServer scope. The values can be accessed in the main server scope as returnValue$a[[firstUI_index]](). See output$text.

library(shiny)

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

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

  output$first <- renderUI({
    selectInput(ns("select"), h4("Select"), paste0(isolate(a()), letters[1:4]))
  })

  return(reactive({ paste0(input$select) }))
}

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, a = list())

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

    params$a[[params$btn]] <- 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)
}

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

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


  a <- reactive({ input$a })
  comp <- callModule(
    addRmBtnServer, id = "addRm",
    moduleToReplicate = list(
      ui = firstUI,
      server = firstServer,
      remover = removeFirstUI
    ),
    a = a
  )
  output$text <- renderText({ 
    if(comp$btn>0)
      paste(
        "a = ", comp$a[[comp$btn]](), 
        "comp = ", comp$btn
      ) 
  })

}

shinyApp(ui = ui, server = server)

R Shiny: Accessing reactive elements in nested shiny modules

1 Answers