闪亮的observeEvent表达式不止一次运行

Question

单击操作按钮一次，我的observeEvent表达式将运行两次。

具体来说，当运行以下代码时，如果单击“添加项目”按钮，然后单击第一个“删除”按钮，则会打印“已删除1”消息两次。这是我最初在更复杂的上下文中观察到的行为的最小示例。

（在更复杂的示例中，多次运行的行为表现为当单击一个删除按钮时所有项目都被删除。我确定这是因为删除特定索引处的项目的删除逻辑多次运行。）

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)

为什么只在单击一次删除按钮时，print语句会多次运行？怎么解决这个问题？

最初，我没有observer$destroy()和once = TRUE。这些都是为了阻止代码多次运行而添加的。

我的包版本：

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

Answer 1

这是因为当点击Add Item时，会为所有现有的删除按钮创建一个新的观察者。这可以通过跟踪单击的按钮并仅为创建的新按钮创建观察者来解决。我确信这可以用在你上面提供的例子中，但是，个人使用splat和mapply有点难以理解。无论如何，使用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

感谢Sada93的回答，因为它很好地解释了这个问题。给出的解决方案有效，但涉及许多变化，所以我想看看是否有更简单的方法。看起来使ID唯一是解决它的一种方法。通过使用时间戳使ID唯一，它可以防止观察者被添加两次，因为该元素基本上是重建的。它可能不是最有效的解决方案，但确实有效。

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

在上下文中：

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)