I've searched stackoverflow and the complete web, but I can't find to seem a good answer to this, seemingly simple, problem.
The situation is as follows:
The problem that arises is the following:
Solution needed
AirdatePickerInput from Shinywidgets has this specific feature (update_on=c('change', 'close'). What I need is that my pickerInput gets updated only on 'close'. So that the resulting values are send only once back to the server.Example: UI
ui <- fluidPage(
# Title panel
fluidRow(
column(2,
wellPanel(
h3("Filters"),
uiOutput("picker_a"),
uiOutput("picker_b"),
)
),
)
)
Server
server <- function(input, output, session) {
# Start values for each filter
all_values_for_a <- tbl(conn, "table") %>%
distinct(a) %>%
collect()
all_values_for_b <- tbl(conn, "table") %>%
distinct(b) %>%
collect()
output$picker_a <- renderUI({
pickerInput(
inputId = "picker_a",
label = "a:",
choices = all_values_for_a,
selected = all_values_for_a,
multiple = TRUE,
options = list("live-search" = TRUE, "actions-box" = TRUE))
})
output$picker_b <- renderUI({
pickerInput(
inputId = "picker_b",
label = "b:",
choices = all_values_for_b,
selected = all_values_for_b,
multiple = TRUE,
options = list("live-search" = TRUE, "actions-box" = TRUE))
})
#I want this code to be executed ONLY when
#picker_a is closed, not everytime when the user
#picks an item in picker_a
observeEvent(
input$picker_a,
{
all_values_for_b <- tbl(conn, "table") %>%
filter(a %in% !!input$picker_a) %>%
distinct(b) %>%
collect()
updatePickerInput(session, "picker_b", choices = all_values_for_b, selected = all_values_for_b)
})
)
)
}
You can probably use an actionButton to delay the execution of the update once all values have been picked by the user.
Or use a debounce function, see this other post.
EDIT
The update_on = c("change", "close") feature was asked for the pickerInput widget to the shinyWidgets developer (Victor Perrier) on GitHub.
Victor's answer was:
there's no similar argument for pickerInput, but there's a special input to know if menu is open or not. So you can use an intermediate reactiveValue to achieve same result.
and he provided the following code:
library(shiny)
library(shinyWidgets)
ui <- fluidPage(
fluidRow(
column(
width = 4,
pickerInput(
inputId = "ID",
label = "Select:",
choices = month.name,
multiple = TRUE
)
),
column(
width = 4,
"Immediate:",
verbatimTextOutput("value1"),
"Updated after close:",
verbatimTextOutput("value2")
),
column(
width = 4,
"Is picker open ?",
verbatimTextOutput("state")
)
)
)
server <- function(input, output) {
output$value1 <- renderPrint(input$ID)
output$value2 <- renderPrint(rv$ID_delayed)
output$state <- renderPrint(input$ID_open)
rv <- reactiveValues()
observeEvent(input$ID_open, {
if (!isTRUE(input$ID_open)) {
rv$ID_delayed <- input$ID
}
})
}
shinyApp(ui, server)
In your case you could try:
observeEvent(
input$picker_a_open,
{
if (!isTRUE(input$picker_a_open)) {
all_values_for_b <- tbl(conn, "table") %>%
filter(a %in% !!input$picker_a) %>%
distinct(b) %>%
collect()
updatePickerInput(session, "picker_b", choices = all_values_for_b, selected = all_values_for_b)
}
})