在循环中生成的insertUI中的observeEvent

Question

When I create new objects with insertUI in a reactive way, all the observers that I create work perfectly fine, as you can see in the following dummy code:

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))

However, if I create the same objects using a for loop, only the observers of the last object created seem to work, as you can see in the example below:

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))

What am I doing wrong?

Can it be related to lazy evaluation?

Answer 1

For loops in R all run in the same scope, which means a variable defined in the loop will be shared by all iterations. This is an issue if you create a function in each loop iteration that accesses this variable, and assume that it'll be unique for each iteration.

Here's a simple demo:

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
}

In this Shiny app, the observeEvent handler accesses the local variable add , and doesn't get called until after the for loop is over, and add is at its final value.

There are a few ways to get around this and create a unique scope for each loop iteration. My favorite is to use an apply function to replace the for loop. Then each apply iteration runs in its own function so local variables are unique each item.

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))

Note that I also removed the outer observeEvent since the server function runs on session initialization anyway.

Answer 2

I've found a workaround but I guess it should be done in a more efficient way.

It looks like this problem is related to lazy evaluation, so only the last object created has its observeEvent working. Thus, I've decided to create, for each iteration of the loop new variables using 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))

As it can be seen, each loop has new variables, so the lazy-evaluation problem is solved.

What I would like to now is if it can be done in a more efficient way.