dynamically creating multiple server module objects results in duplicate named servers

[SokolovAnatoliy]

This is a post to describe some behavior that I am seeing that is maybe a bug or perhaps just shiny not working in the way I expected.

A brief description of what I am trying to do is encapsulated in the provided reprex.

The ultimate goal is creating a number of modules on demand. In this case, I am using a numericInput to create a number of modules equal to the number selected by the user.

To accomplish this task, I create the UI's on demand using lapply (or map) combined with renderUI. I additionally, need to create the module server objects, and provide both of these objects the same id. I added a print statement inside the server and the UI, so we can see the code run every time we create a UI or server module object.

I also added a pop-up button inside of the module, because this helps to easily demonstrate the issue at hand.

The app works just fine and can create the desired inputs/monitor these inputs using the created servers.

However, what I observed is that a NEW server object with the same id is created every time you run the lapply loop.

So, in a simple scenario, when this app is initiated, the numericInput is equal to 1. So, I have a server/UI combination with the "select1" id. The output prints "server select1" and "ui select1". When a user presses the pop-up button inside the "select1" module, you see a SINGLE pop up. This works as expected.

Now, when a user increments the numericInput to 2. What I expected to happen was the following

create two UI's and two servers with the id of "select1" and "select2".

What actually happens is:
I create TWO UIs with ids of "select1" and "select2"
and
I obtain THREE server objects with the ids of "select1", "select1", and "select2".

This behavior occurs because renderUI destroys the previous instance of the UI when lapply is run. So, the previous version of "select1" UI is destroyed, and overwritten. For this reason, there is no error on duplicate input names. That actually is important, because normally creating ui objects with the same name gives an error; however, in this case no error is given because the duplication is in the server objects. This makes troubleshooting difficult, since the lack of error made me assume that duplicate objects were not an issue.

The process of module server creation does NOT destroy the object, so there are now TWO servers with the id "select1" and ONE server with the id "select2".

This is most easily checked by pressing the pop-up button. After updating the numericInput to 2, pressing the pop-up button from the first module, will result in TWO pop-ups. Pressing the pop-up button from the second module will result in ONE pop-up.

The pattern will continue, as more modules are created. So, with 3 modules, the first button will result in 3 pop-ups, the second button will result in 2 pop-ups and the last one will result in a single pop-up.

Here is the code to show the behavior.

library(shiny)

selectInputUI <- function(id) {
  ns <- NS(id)
  print(paste("ui", id))
  tagList(
    selectInput(ns("select"), "Select", choices = c("Option 1", "Option 2", "Option 3")),
    actionButton(ns("show_popup"), "Show Popup")
  )
}

selectInputServer <- function(id) {
  moduleServer(id, function(input, output, session) {
    print(paste("server", id))
    
    observe({
      shinyalert::shinyalert(title = "Success!", text = {
        "It worked!!"
      }, type = "success")

    }) %>% bindEvent(input$show_popup)

  })

  }

ui <- fluidPage(
  numericInput("num", "Number of Select Inputs", value = 1, min = 1),
  uiOutput("selectInputs")
)

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

  observe({
      lapply(1:input$num, function(i) {
        selectInputServer(paste0("select", i))
      })
  })

  output$selectInputs <- renderUI({
    lapply(1:input$num, function(i) {
      selectInputUI(paste0("select", i))
    })
  })


}

I believe the end result makes sense but was not the expected behavior for me. Here is the way I was going around this issue. Essentially, I had to watch for how many modules are created and only create new server objects for the NEW modules, and not re-create the previous servers. Haven't thought about potentially destroying the server objects when the count is decremented though.

Here is the updated code "fixing" the problem. If you update the server code above to this version, you will note that the pop-up buttons only show 1 pop-up no matter what module the pop-up is called from.

server <- function(input, output, session) {
  numModules <- reactiveVal(0) # Keep track of the number of modules

  observe({
    if (input$num > numModules()) {
      lapply((numModules() + 1):input$num, function(i) {
        selectInputServer(paste0("select", i))
      })
      numModules(input$num) 
    }
  })

  output$selectInputs <- renderUI({
    lapply(1:input$num, function(i) {
      selectInputUI(paste0("select", i))
    })
  })
}

So I posted this in the hopes that 1) it would be useful for someone who is scratching their heads about multiple pop-ups, and 2) to ask if this is really the intended behavior? Or should multiple server objects with the same name give a warning / error?

[scal-o]

Hi! A little clarification: what is causing the problem here are not the duplicated "server objects", but rather the observer objects that they create. Every time you call selectInputServer(*id*) you create a new observer object with a binding to the *id*-show_popup input. So every time you increase the numeric input, you create a new series of observers all bound to the respective *id*-show_popup inputs, and that's why the shinyalert gets triggered multiple times.

One thing you could do to avoid issues (like creating the wrong number of objects and then just having them lying around occupying space and possibly resources) is destroying all of the previously created observers and creating anew only the ones you actually need every time input$num changes. This can be done via the destroy() method of the observer objects. Here is an example of how you could do it.

In the module server, list all of the observers you create to the session$userData$choose_a_name list. This will make the observer objects visible from the main server function.

selectInputServer <- function(id) {
  moduleServer(id, function(input, output, session) {
    print(paste("server", id))
    
    session$userData$observers[[id]] <- observe({
      shinyalert::shinyalert(title = "Success!", text = {
        "It worked!!"
      }, type = "success")
      
    }) %>% bindEvent(input$show_popup, ignoreInit = TRUE)
    
  })
}

In the main server function, call the destroy method on every observer object listed in session$userData$choose_a_name, and then generate the observers you need with lapply.

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

    if (length(session$userData$observers) != 0) {
      session$userData$observers <- lapply(
        session$userData$observers,
        function(obs) obs$destroy())
    }

    lapply(1:input$num, function(i) {
      selectInputServer(paste0("select", i))
    })

  })
  
  output$selectInputs <- renderUI({
    lapply(1:input$num, function(i) {
      selectInputUI(paste0("select", i))
    })
  })
  
  
}

By using this method you would also not need the numModules counter.
You can read some documentation about observer methods at ?observe, in the value section.
You can read about the session$userData environment at ?session, in the value section.
For a perhaps more clear explanation of what the code above does, look into this.

[SokolovAnatoliy]

Thank you for a very clear explanation and links @scal-o! As that blog pointed out, I have been pulling my hair out about it.