Shiny observeEvent expression runs more than once

Question

My observeEvent expression is being run twice when the action button is clicked once.

Specifically, when the code below is run, if the "Add Item" button is clicked and then the first "Delete" button is clicked, the "deleted 1" message is printed twice. This is a minimal example of the behavior that I originally observed in a more complicated context.

(In that more complicated example, the behavior of running multiple times was manifesting as all items being deleted when one delete button was clicked. I determined that it was because the delete logic to remove an item at a particular index was running multiple times.)

library(plyr)
library(shiny)

ui <- fluidPage(
  actionButton("addItem", "Add Item"),
  uiOutput("items")
)

server <- function(input, output, session) {
  itemsReactive <- reactiveVal(list(Item1 = "foo"))
  observeEvent(input$addItem, {
    itemsReactive(c(itemsReactive(), list(Item2 = "foo")))
  })
  output$items <- renderUI({
    splat(div)(
      unname(mapply(function(item, index) {
        deleteButtonId <- paste('delete-button', index, sep = '-')
        observer <- observeEvent(input[[deleteButtonId]], {
          print(paste("deleted", index))
          observer$destroy()
        }, once = TRUE)
        div(actionButton(deleteButtonId, "Delete"))
      }, itemsReactive(), seq_along(itemsReactive()), SIMPLIFY = FALSE))
    )
  })
}

shinyApp(ui = ui, server = server)

Why does the print statement run more than once when the delete button is only clicked once? How can this be fixed?

Originally, I did not have the observer$destroy() nor the once = TRUE . These were added each in an attempt to stop the code from running multiple times.

My package versions:

other attached packages:
[1] plyr_1.8.4  shiny_1.2.0

Answer 1

Its because a new observer is created for all the existing delete buttons when Add Item is clicked. This can be fixed by tracking which button has been clicked and creating an observer for only the new button created. I'm sure this can be worked into the example you have provided above, however, personally this was a little difficult to follow with the use of splat and mapply . Anyway, the addition of new button can be simplified with the use of a tagList .

library(shiny)

ui <- fluidPage(
  actionButton("addItem", "Add Item"),
  uiOutput("items")
)



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

  new_bttn_added <- reactiveVal(0) #index to track new button
  delete_id <- c() #IDs of the delete buttons
  index <- 1 #Counter
  taglist <- tagList() #Button Taglist to display in uiOutput("items")

  output$items <- renderUI({
    req(input$addItem) # reactivity when addItem is clicked

    delete_id <<- c(delete_id,paste0("bttn",index)) #Append the new ID of the button being created
    taglist <<- tagList(taglist,div(actionButton(delete_id[index],"Delete"))) #Append button to taglist
    index <<- index + 1 #Increment index

    #Increment the button counter
    isolate({
      val <- new_bttn_added()
      val <- val + 1
      new_bttn_added(val)
    })
    return(taglist)
  })

  observe({
    #This section is triggered only when a new button is added
    # Reactive dependance on only new_bttn_added() to avoid race conditions

    id <- delete_id[new_bttn_added()]
    lapply(id,function(x){
      observeEvent(input[[x]],{
        # Do something with the new delete button here
        cat("Pressed",x,"\n")
      })
    })
  })
}

shinyApp(ui = ui, server = server)

Answer 2

Thank you to Sada93 for their answer as it explained the problem very nicely. The solution given works but involved many changes so I wanted to see if there was an easier way. It looks like making the IDs unique is one way to solve it. By making the ID unique with a timestamp, it prevents the observer from getting added twice because the element is basically rebuilt. It's probably not the most efficient solution but it does work.

curTime <- toString(round(as.numeric(Sys.time()) * 1000))
deleteButtonId <- paste('delete-button', index, curTime, sep = '-')

In context:

library(plyr)
library(shiny)

ui <- fluidPage(
  actionButton("addItem", "Add Item"),
  uiOutput("items")
)

server <- function(input, output, session) {
  itemsReactive <- reactiveVal(list(Item1 = "foo"))
  observeEvent(input$addItem, {
    itemsReactive(c(itemsReactive(), list(Item2 = "foo")))
  })
  output$items <- renderUI({
    splat(div)(
      unname(mapply(function(item, index) {
        curTime <- toString(round(as.numeric(Sys.time()) * 1000))
        deleteButtonId <- paste('delete-button', index, curTime, sep = '-')
        observer <- observeEvent(input[[deleteButtonId]], {
          print(paste("deleted", index))
          observer$destroy()
        }, once = TRUE)
        div(actionButton(deleteButtonId, "Delete"))
      }, itemsReactive(), seq_along(itemsReactive()), SIMPLIFY = FALSE))
    )
  })
}

shinyApp(ui = ui, server = server)