r - Generate observers for dynamic number of inputs

Question

I have what I think is a pretty simple user case that I haven't been able to find a solution for: I want Shiny to generate a user-specified number of inputs, dynamically creating an observer for each.

In the minimal reproducible code below, the user indicates the number of action buttons desired by typing into the textInput widget; he or she then presses "submit", which generates the action buttons.

What I want is for the user to then be able to click on any action button and generate an output specific to it (e.g. for the minimal case, just print the name of the button):

library("shiny")

ui <- fluidPage(textInput("numButtons", "Number of buttons to generate"), 
                actionButton("go", "Submit"), uiOutput("ui"))

server <- function(input, output) {

        makeObservers <- reactive({

                lapply(1:(as.numeric(input$numButtons)), function (x) {

                        observeEvent(input[[paste0("add_", x)]], {

                                print(paste0("add_", x))

                        })

                }) 
        })

        observeEvent(input$go, {

                output$ui <- renderUI({

                        num <- as.numeric(isolate(input$numButtons))

                        rows <- lapply(1:num, function (x) {

                                actionButton(inputId = paste0("add_", x), 
                                         label = paste0("add_", x))

                        })

                        do.call(fluidRow, rows)

                })

                makeObservers()

        })


}

shinyApp(ui, server)

The problem with the code above is that somehow several observers are created, but they all take as their input only the last item in the list passed to lapply. So if I generate four action buttons, and I click on action button #4, Shiny prints its name four times, while all the other buttons don't react.

The idea to generate observers using lapply comes from https://github.com/rstudio/shiny/issues/167#issuecomment-152598096

Answer 1

In your example everything works fine so long an actionButton has been pressed only once. For instance, when I create 3 buttons/observers I get correct IDs printed in the console - there is one observer for each new generated actionButton. √

[1] "add_1"
[1] "add_2"
[1] "add_3"

However, when I choose the number other than 3 and then press submit again, the problem you described begins.

Say, I want now 4 actionButtons - I input 4 and press submit. After that, I press once each new generated button and I get a following output:

[1] "add_1"
[1] "add_1"
[1] "add_2"
[1] "add_2"
[1] "add_3"
[1] "add_3"
[1] "add_4"

By clicking on submit button, I created observers for three first buttons again - I have two observers for the first three buttons and only one for the new fourth button.

We can play this game on and on and going to get more and more observers for each button. It is very similar when we create a smaller number of buttons than previously.

---

The solution to this would be to keep track of which action buttons have been already defined and then to generate observers only for new ones. In the example below I depicted how you could do this. It may not be best programmed but it should serve well to show the idea.

Full example:

library("shiny")

ui <- fluidPage(
  numericInput("numButtons", "Number of buttons to generate",
                min = 1, max = 100, value = NULL),  
  actionButton("go", "Submit"), 
  uiOutput("ui")
)

server <- function(input, output) {

  # Keep track of which observer has been already created
  vals <- reactiveValues(x = NULL, y = NULL)

  makeObservers <- eventReactive(input$go, {

    IDs <- seq_len(input$numButtons)

    # For the first time you press the actionButton, create 
    # observers and save the sequence of integers which gives
    # you unique identifiers of created observers
    if (is.null(vals$x)) { 
      res <- lapply(IDs, function (x) {
        observeEvent(input[[paste0("add_", x)]], {
          print(paste0("add_", x))
        })
      })
      vals$x <- 1
      vals$y <- IDs
    print("else1")

    # When you press the actionButton for the second time you want to only create
    # observers that are not defined yet
    #

    # If all new IDs are are the same as the previous IDs return NULLL
    } else if (all(IDs %in% vals$y)) {
        print("else2: No new IDs/observers")
        return(NULL)

    # Otherwise just create observers that are not yet defined and overwrite 
    # reactive values 
    } else {
        new_ind <- !(IDs %in% vals$y)
        print(paste0("else3: # of new observers = ", length(IDs[new_ind])))
        res <- lapply(IDs[new_ind], function (x) {
          observeEvent(input[[paste0("add_", x)]], {
            print(paste0("add_", x))
          })
        })
        # update reactive values
        vals$y <- IDs
    }
    res
  })


  observeEvent(input$go, {

    output$ui <- renderUI({

      num <- as.numeric(isolate(input$numButtons))

      rows <- lapply(1:num, function (x) {

        actionButton(inputId = paste0("add_", x),
                     label = paste0("add_", x))

      })

      do.call(fluidRow, rows)

    })
    makeObservers()
  })

}
shinyApp(ui, server)