Блестящее реактивное выражение, выполненное дважды, а не один раз - PullRequest
0 голосов
/ 10 марта 2019

Я использую этот блестящий модуль для динамического создания selectizeInputs с insertUI. Выбранные значения затем записываются в reactive и передаются в другие модули (где, например, на основании этого reactive выполняется длительный запрос к базе данных).

Проблема в том, что в настоящее время, если создается новый selectizeInput, реактивное выражение выполняется дважды, в то время как оно должно выполняться только один раз! Как мне этого добиться?

library(shiny)

cats <- function(...) cat(file = stderr(), ..., "\n")
timestamp <- function() as.character(Sys.time())
cats_time <- function(...) cats(timestamp(), "...", ...)

mod_ui <- function(id) {
  ns <- NS(id)
  tagList(
    selectizeInput(
      ns("select.filter.var"),
      label = "Filter",
      multiple = TRUE,
      selected = c("cyl"),
      choices = names(mtcars)
    ),
    tags$div(id = ns('placeholder'))
  )
}

mod <- function(input, output, session) {

  ns <- session$ns
  session$onSessionEnded(function() {stopApp()})

  values <- reactiveValues(
    input.vars = NULL
  )

  observeEvent(input$select.filter.var, {

    new.vars <- setdiff(input$select.filter.var, values$input.vars)

    for (i in new.vars) {

      choices <- unique(mtcars[[i]])

      new.input <-
        tags$div(
          selectizeInput(ns(i),
                         label = i,
                         selected = FALSE,
                         choices = choices,
                         multiple = TRUE),
          id = ns(i))

      print(paste0("#", ns("placeholder")))

      insertUI(
        selector = paste0("#", ns("placeholder")),
        where = "beforeEnd",
        ui = new.input)
    }

    deleted.vars <- setdiff(values$input.vars, input$select.filter.var)

    for (i in deleted.vars) {
      removeUI(
        selector = paste0("#", ns(i))
      )
    }

    values$input.vars <- input$select.filter.var
  })

  reactive({
    cats_time("Executing reactive")
    # Sys.sleep(1)
    input.names <- values$input.vars
    filters <- lapply(input.names, function(x) input[[x]])
    names(filters) <- input.names
    filters
  })
}

ui <- fluidPage(mod_ui("test"), verbatimTextOutput("filters"))
server <- function(input, output, session) {
  x <- callModule(mod, "test")
  output$filters <- renderPrint({
    x()
  })
}

shinyApp(ui, server)
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...