Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

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

Tags:

r

shiny

I have a simple toy example that uses an add/removeBtn module to add and remove UI from "first" module. I need to keep track of the number of times add/remove has been clicked. If I do not use modules, it is easy, but I am trying to do this in the context of nested modules. Code is below, but basically, I cannot seem to get access to the return from the addRmBtnServer() in the main server function. I am sure it is a simple fix, but I have tried many ways around this, but cannot seem to get access to the result from my call to addRmBtnServer(). Thanks!

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)
like image 408
Sean Sinykin Avatar asked Oct 05 '17 23:10

Sean Sinykin


Video Answer


1 Answers

As said in the comment, you can pass the values as return values in the corresponding server functions. There is a working example below. I left out the firstUI, firstServer and removeFirstUI implementations since they are irrelevant for your problem.

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)
like image 139
Gregor de Cillia Avatar answered Dec 22 '22 00:12

Gregor de Cillia