He buscado en stackoverflow y en la web completa, pero no puedo encontrar una buena respuesta a este problema aparentemente simple.
La situación es la siguiente:
El problema que se presenta es el siguiente:
Solución necesaria
AirdatePickerInput de Shinywidgets tiene esta característica específica ( update_on=c('change', 'close') . Lo que necesito es que mi pickerInput se actualice solo en 'close'. Para que los valores resultantes se envíen solo una vez al servidor .Ejemplo: interfaz de usuario
ui <- fluidPage( # Title panel fluidRow( column(2, wellPanel( h3("Filters"), uiOutput("picker_a"), uiOutput("picker_b"), ) ), ) )Servidor
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) }) ) ) }Probablemente pueda usar un botón de acción para retrasar la ejecución de la actualización una vez que el usuario haya seleccionado todos los valores.
O use una función de debounce , vea esta otra publicación .
EDITAR
Se solicitó la update_on = c("change", "close") para el widget pickerInput al desarrollador de shinyWidgets (Victor Perrier) en GitHub .
La respuesta de Víctor fue:
no hay un argumento similar para pickerInput, pero hay una entrada especial para saber si el menú está abierto o no. Entonces puede usar un valor reactivo intermedio para lograr el mismo resultado.
y proporcionó el siguiente código:
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)En tu caso podrías probar:
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) } })