3
votes

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:

  • I have a Shiny application, connected with a database
  • I have several user inputs (Pickerinputs), where a user can select multiple arguments
  • The user inputs are all dependent on each other

The problem that arises is the following:

  • If a user ticks multiple car brands (for example, Renault, Peugeot and BMW) then the pickerinput that is linked to this selection (specific car models for these brands) gets updated three times. With many pickerinputs that are linked to each other, this creates messy UX.

Solution needed

  • I think the solution is simple: the pickerinput only needs to send the selected values after the input has been closed; it does not need to send values (and trigger updates) after every pick a user makes. The 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)
    })
    )
  )
}
1

1 Answers

2
votes

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)
}
    })