在循环中生成的insertUI中的observeEvent

Question

当我以反应方式用insertUI创建新对象时，我创建的所有观察者都可以正常工作，如下面的虚拟代码所示：

library(shiny)

# Define the UI
ui <- fluidPage(
  actionButton("adder", "Add"),
  tags$div(id = 'placeholder')
)


# Define the server code
server <- function(input, output) {
  rv <- reactiveValues()

  rv$counter <- 0

  observeEvent(input$adder,{
    rv$counter <- rv$counter + 1

    add <- sprintf("%03d",rv$counter)

    filterId <- paste0('adder_', add)
    divId <- paste0('adder_div_', add)
    elementFilterId <- paste0('adder_object_', add)
    removeFilterId <- paste0('remover_', add)

    insertUI(
      selector = '#placeholder',
      ui = tags$div(
        id = divId,
        actionButton(removeFilterId, label = "Remove filter", style = "float: right;"),
        textInput(elementFilterId, label = paste0("Introduce text #",rv$counter), value = "")
      )
    )

    # Observer that removes a filter
    observeEvent(input[[removeFilterId]],{
      removeUI(selector = paste0("#", divId))
    })
  })
}

# Return a Shiny app object
shinyApp(ui = ui, server = server, options = list(launch.browser = T))

但是，如果我使用for循环创建相同的对象，则仅在最后一个创建的对象的观察者看来有效，如下面的示例所示：

library(shiny)

# Define the UI
ui <- fluidPage(
  #actionButton("adder", "Add"),
  tags$div(id = 'placeholder')
)


# Define the server code
server <- function(input, output) {
  rv <- reactiveValues()

  rv$counter <- 0
  rv$init <- T

  observeEvent(rv$init, {
    if(!rv$init) return(NULL)

    rv$init <- F

    for(i in 1:3) {
      rv$counter <- rv$counter + 1

      add <- sprintf("%03d",rv$counter)

      #prefix <- generateRandomString(1,20)
      filterId <- paste0('adder_', add)
      divId <- paste0('adder_div_', add)
      elementFilterId <- paste0('adder_object_', add)
      removeFilterId <- paste0('remover_', add)

      insertUI(
        selector = '#placeholder',
        ui = tags$div(
          id = divId,
          actionButton(removeFilterId, label = "Remove filter", style = "float: right;"),
          textInput(elementFilterId, label = paste0("Introduce text #",rv$counter), value = "")
        )
      )

      # Observer that removes a filter
      observeEvent(input[[removeFilterId]],{
        removeUI(selector = paste0("#", divId))
      })
    }
  })
}

# Return a Shiny app object
shinyApp(ui = ui, server = server, options = list(launch.browser = T))

我究竟做错了什么？

可能与懒惰评估有关吗？

Answer 1

对于R中的循环，所有循环都在同一范围内运行，这意味着循环中定义的变量将由所有迭代共享。 如果您在每次循环迭代中都创建一个访问该变量的函数，并假定该变量在每次迭代中都是唯一的，则这是一个问题。

这是一个简单的演示：

counter <- 0; funcs <- list()
for (i in 1:3) {
    counter <- counter + 1
    funcs[[i]] <- function() print(counter)
}
for (i in 1:3) {
    funcs[[i]]()  # prints 3 3 3
}

在此Shiny应用程序中， observeEvent处理程序访问局部变量add ，直到for循环结束且add为其最终值后才被调用。

有几种方法可以解决此问题，并为每次循环迭代创建唯一的作用域。 我最喜欢的是使用apply函数替换for循环。 然后，每个apply迭代都在其自己的函数中运行，因此局部变量在每个项目中都是唯一的。

library(shiny)

# Define the UI
ui <- fluidPage(
  #actionButton("adder", "Add"),
  tags$div(id = 'placeholder')
)


# Define the server code
server <- function(input, output) {
  rv <- reactiveValues(counter = 0)

  lapply(1:3, function(i) {
    isolate({
      rv$counter <- rv$counter + 1

      add <- sprintf("%03d",rv$counter)

      #prefix <- generateRandomString(1,20)
      filterId <- paste0('adder_', add)
      divId <- paste0('adder_div_', add)
      elementFilterId <- paste0('adder_object_', add)
      removeFilterId <- paste0('remover_', add)

      insertUI(
        selector = '#placeholder',
        ui = tags$div(
          id = divId,
          actionButton(removeFilterId, label = "Remove filter", style = "float: right;"),
          textInput(elementFilterId, label = paste0("Introduce text #",rv$counter), value = "")
        )
      )
    })

    # Observer that removes a filter
    observeEvent(input[[removeFilterId]],{
      removeUI(selector = paste0("#", divId))
    })
  })
}

# Return a Shiny app object
shinyApp(ui = ui, server = server, options = list(launch.browser = T))

请注意，由于服务器功能observeEvent在会话初始化上运行，因此我也删除了外部的observeEvent 。

Answer 2

我找到了一种解决方法，但我想应该以更有效的方式完成它。

看来此问题与延迟求值有关，因此只有最后创建的对象才具有其watchEvent的功能。 因此，我决定使用eval为循环的每次迭代创建新变量：

library(shiny)

# Define the UI
ui <- fluidPage(
  #actionButton("adder", "Add"),
  tags$div(id = 'placeholder')
)


# Define the server code
server <- function(input, output, session) {
  rv <- reactiveValues()

  rv$counter <- 0
  rv$init <- T

  observeEvent(rv$init, {
    if(!rv$init) return(NULL)

    for(i in 1:4) {
      rv$counter <- rv$counter + 1

      add <- sprintf("%03d",rv$counter)

      coding <- paste0(
        "divId",add," <- paste0('adder_div_', add);
        elementFilterId",add," <- paste0('adder_object_', add);
        removeFilterId",add," <- paste0('remover_', add);
        insertUI(
          selector = '#placeholder',
          ui = tags$div(
            id = divId",add,",
            actionButton(inputId=removeFilterId",add,", label = \"Remove filter\", style = \"float: right;\"),
            textInput(inputId=elementFilterId",add,", label = paste0(\"Introduce text #\",rv$counter), value = '')
          )
        );

        # Observer that removes a filter
        observeEvent(input[[removeFilterId",add,"]],{
          removeUI(selector = paste0(\"#\", divId",add,"))
        })
        "
      )

      eval(parse(text=coding))
    }

    rv$init <- F
  })
}

# Return a Shiny app object
shinyApp(ui = ui, server = server, options = list(launch.browser = T))

可以看出，每个循环都有新变量，因此可以解决延迟评估问题。

我现在想说的是，是否可以更有效的方式来完成这项工作。