Я использую этот блестящий модуль для динамического создания 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)