R Shiny - Saving results of dynamically created modules - r

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)