R Shiny - неожиданное поведение updateSelectizeInput с наблюдателем

Question

У меня есть selectizeInput, который может принимать несколько значений (здесь: имена наборов данных). Текущее состояние этого входа контролируется с помощью observeEvent, который отображает соответствующие таблицы данных и динамически заполняет tabsetPanel выходными данными. Все работает нормально, когда я выбираю новые значения прямо в поле ввода. Однако, когда я предоставляю несколько новых значений с помощью функции updateSelectizeInput, все вкладки содержат один и тот же кадр данных, соответствующий последнему значению в аргументе selected.

Приведенный ниже пример иллюстрирует проблему. Пользовательский интерфейс реагирует, как и ожидалось, при использовании поля ввода, но при нажатии кнопки «Добавить все сразу» все вкладки содержат один и тот же кадр данных.

library(shiny)
library(shinyWidgets)
library(shinyjs)
library(DT)

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      selectizeInput(inputId = "dataframes", label = "select dataframes", choices = c("iris", "mtcars", "DNase", "ChickWeight"), multiple = TRUE),
      actionButton(inputId = "add_all", label = "Add all at once")
    ),
    mainPanel(tabsetPanel(id = "df_tabset"))
  )
)

server <- function(input, output, session) {
  tables <- reactiveValues(iris = iris, mtcars = mtcars, DNase = DNase, ChickWeight = ChickWeight, 
                           df_tabset = NULL) # keeps track of currently displayed tables

  observeEvent(input$dataframes, {
    if (length(input$dataframes) > length(tables$df_tabset)) { # new dataframes are selected
      new_dfs = setdiff(input$dataframes, tables$df_tabset)
      for(df in new_dfs){
        output[[df]] = renderDT(tables[[df]], editable = T, rownames = F, options = list(dom = "t")) # DOES NOT WORK AS EXPECTED IF THERE is > 1 NEW DF
        appendTab(inputId = "df_tabset", select = TRUE,
                  tabPanel(title = df, value = df, DTOutput(outputId = df))
        )
      }
      tables$df_tabset = input$dataframes # update 
    } else {
      df = tables$df_tabset[! tables$df_tabset %in% input$dataframes]
      removeTab(inputId = "df_tabset", target = df)
      tables$df_tabset = input$dataframes
    }
  }, ignoreNULL = FALSE, ignoreInit = TRUE)

  observeEvent(input$add_all, {
    updateSelectizeInput(session, "dataframes", selected = c("iris", "mtcars", "DNase", "ChickWeight"))
  })
}

shinyApp(ui = ui, server = server)

Answer 1

Вы должны использовать local (см. здесь ).

  observeEvent(input$dataframes, {
    if (length(input$dataframes) > length(tables$df_tabset)) { # new dataframes are selected
      new_dfs = setdiff(input$dataframes, tables$df_tabset)
      for(df in new_dfs){
        local({
          .df <- df
          output[[.df]] = renderDT(tables[[.df]], editable = TRUE, 
                                   rownames = FALSE, options = list(dom = "t")) 
        })
        appendTab(inputId = "df_tabset", select = TRUE,
                  tabPanel(title = df, value = df, DTOutput(outputId = df))
        )
      }
      tables$df_tabset = input$dataframes # update 
    } else {
      df = tables$df_tabset[! tables$df_tabset %in% input$dataframes]
      removeTab(inputId = "df_tabset", target = df)
      tables$df_tabset = input$dataframes
    }
  }, ignoreNULL = FALSE, ignoreInit = TRUE)