insertUI 中循环生成的observeEvent

asu*_*uka 3 user-interface r insert lazy-evaluation shiny

当我以响应式方式使用 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))
Run Code Online (Sandbox Code Playgroud)

但是,如果我使用 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))
Run Code Online (Sandbox Code Playgroud)

我究竟做错了什么?

这可能与惰性评估有关吗?

gre*_*g L 5

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

这是一个简单的演示:

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
}
Run Code Online (Sandbox Code Playgroud)

在此 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))
Run Code Online (Sandbox Code Playgroud)

请注意,我还删除了外部observeEvent,因为服务器函数无论如何都在会话初始化时运行。