Наблюдение за событием в insertUI, сгенерированном в цикле - PullRequest
Новая
       22

Наблюдение за событием в insertUI, сгенерированном в цикле

0 голосов
/ 20 октября 2018

Когда я создаю новые объекты с помощью 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))

Что я делаю не так?

Можетэто будет связано с ленивой оценкой?

Ответы [ 2 ]

0 голосов
/ 21 октября 2018

Для циклов в 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 не будетover, и 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, поскольку серверная функция все равно выполняется при инициализации сеанса.

0 голосов
/ 20 октября 2018

Я нашел обходной путь, но я думаю, что это должно быть сделано более эффективным способом.

Похоже, что эта проблема связана с отложенной оценкой, поэтому работает только последний созданный объект, который имеет свой наблюдение.Таким образом, я решил создать для каждой итерации цикла новые переменные с использованием 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))

Как видно, у каждого цикла есть новые переменные, поэтому проблема с отложенной оценкой решена.

Я бы хотел, чтобы это было сделано более эффективным способом.

...