R Shiny - Saving results of dynamically created modules

Question

I encountered the following problem that I have tried to summarize in this minimal reproducible example.

The app should be able to dynamically create modules and render the UI of the module - obj_UI in my example - in a tab of the tabsetpanel objTP. Each of this modules should render a R6 object of type objR6. I would like to save the resulting R6 objects into a reactiveValues variable called objCollection and display it in the verbatimTextOutput called displayValues.

When clicking on the input$addObject button, I get the error message "Error in <-: cannot add bindings to a locked environment". I believe the problem lies in the observeEvent at the very end of the example, but cannot figure what it is.

Any help would be much appreciated!

library(shiny)
library(R6)

# Simple R6 object
objR6 <- R6::R6Class(
  "objR6",
  public = list(
    identifier = NULL,
    selected_value = NULL,

    initialize = function(identifier) {
      self$identifier <- identifier
    }
  )
)

# Module Ui
obj_UI <- function(id) {
  tagList(
    selectInput(NS(id, "value"), "Chose Value", letters)
  )
}

# Module Server
obj_Server <- function(id) {
  moduleServer(id, function(input, output, session) {

    obj <- reactiveVal(objR6$new(id))

    observeEvent(input$value, {
      newObj <- obj()$clone()
      newObj$selectec_value <- input$value
      obj(newObj)
    })


    return(reactive(obj()))

  })
}


# Shiny App
ui <- fluidPage(
  fluidPage(
    selectInput("objSelection", "Select Object",
                choices = "",
                selectize = FALSE,
                size = 10),
    actionButton("addObject", "Add Object"),
    actionButton("rmvObject", "Remove Object"),
    tabsetPanel(id = "objTP"),
    verbatimTextOutput("displayValues")
  )
)

server <- function(input, output, session) {
  objCount <- reactiveVal(0)
  objCollection <- reactiveValues(objects = list())

  # Reaction on action button "addObject"
  observeEvent(input$addObject, {

    # Add another item
    objCount(objCount() + 1)
    newObjName <- paste0("Object_", objCount())
    updateSelectInput(session, "objSelection", choices = c(paste0("Object_", 1:objCount())))

    # Append the object tabset panel
    appendTab("objTP", tabPanel(newObjName, obj_UI(newObjName)), select = TRUE)

  })

  # Reaction on action button "rmvObject"
  observeEvent(input$rmvObject, {
    delObjName <- paste0("Object_", objCount())
    objCount(objCount() - 1)
    updateSelectInput(session, "objSelection", choices = c(paste0("Object_", 1:objCount())))
    removeTab("objTP", target = delObjName)

  })

  # Implement the server side of module
  observeEvent(objCount(), {
    if (objCount() > 0) {

      for (i in 1:objCount()) {
        identifier <- paste0("Object_", i)
        observeEvent(obj_Server(identifier), {
          objCollection$objects[[identifier]] <- obj_Server(identifier)
        })
      }
    }

    # Ouput the selected values
    output$displayValues <- renderPrint({
      reactiveValuesToList(objCollection)
    })

  })


}

shinyApp(ui, server)

Answer 1

The following minimal reproducible example is an answer to the problem above. In comparison to the code above I corrected a typo in the server function of the module and also put the initialization of the server part in the observeEvent for the input$addObject and removed the observeEvent for objCount().

library(shiny)
library(R6)

# Simple R6 object
objR6 <- R6::R6Class(
  "objR6",
  public = list(
    identifier = NULL,
    selected_value = NULL,

    initialize = function(identifier) {
      self$identifier <- identifier
    }
  )
)

# Module Ui
obj_UI <- function(id) {
  tagList(
    selectInput(NS(id, "value"), "Chose Value", letters)
  )
}

# Module Server
obj_Server <- function(id) {
  moduleServer(id, function(input, output, session) {

    obj <- reactiveVal(objR6$new(id))

    observeEvent(input$value, {
      newObj <- obj()$clone()
      newObj$selected_value <- input$value
      obj(newObj)
    })


    return(reactive(obj()))

  })
}


# Shiny App
ui <- fluidPage(
  fluidPage(
    selectInput("objSelection", "Select Object",
                choices = "",
                selectize = FALSE,
                size = 10),
    actionButton("addObject", "Add Object"),
    actionButton("rmvObject", "Remove Object"),
    tabsetPanel(id = "objTP"),
    verbatimTextOutput("displayValues")
  )
)

server <- function(input, output, session) {
  objCount <- reactiveVal(0)
  objCollection <- reactiveValues(objects = list())

  # Reaction on action button "addObject"
  observeEvent(input$addObject, {

    # Add another item
    objCount(objCount() + 1)
    newObjName <- paste0("Object_", objCount())
    updateSelectInput(session, "objSelection", choices = c(paste0("Object_", 1:objCount())))

    # Append the object tabset panel
    appendTab("objTP", tabPanel(newObjName, obj_UI(newObjName)), select = TRUE)

    # Add the server component of the module
    observeEvent(obj_Server(newObjName), {
      objCollection$objects[[newObjName]] <- obj_Server(newObjName)
    })


  })

  # Reaction on action button "rmvObject"
  observeEvent(input$rmvObject, {
    delObjName <- paste0("Object_", objCount())
    if (objCount() > 0) {
      objCount(objCount() - 1)
      removeTab("objTP", target = delObjName)
      objCollection$objects[[delObjName]] <- NULL
      if (objCount() > 0) {
        updateSelectInput(session, "objSelection", choices = c(paste0("Object_", 1:objCount())))
      } else {
        updateSelectInput(session, "objSelection", choices = "")
      }
    }
  })

  # Ouput the selected values
  output$displayValues <- renderPrint({
    lapply(reactiveValuesToList(objCollection)$objects, function(i) {i()})
  })


}

shinyApp(ui, server)