dreamRs / shinyWidgets

shinyWidgets : Extend widgets available in shiny
https://dreamrs.github.io/shinyWidgets/
GNU General Public License v3.0
833 stars 153 forks source link

[Feature Request] Provide all drop down style pickers (pickerInput, virtualSelectInput) the option to update on close #677

Closed dsen6644 closed 8 months ago

dsen6644 commented 8 months ago

While this has been requested before (#392), the solution for explicitly calling the _open input value adds much complexity when working in a modular workflow.

Below I have a sample app that chains reactivity between modules so that updates in the pickers higher up in the hierarchy will dynamically limit the number of options available in subsequent pickers.

Because the inputs are being generated through namespaces it becomes difficult to 'explicitly' call the _open id.

library(shiny)
library(dplyr)
library(shinyWidgets)

# module UI

moduleUI <- function(id, label, choices = NULL) {
  ns <- NS(id)
  tagList(virtualSelectInput(ns("select"), label= label, choices = choices,
                             selected = choices, multiple = TRUE))
}

# module server

moduleController <- function(id, data, selector, input_val, output_val) {
  moduleServer(id, function(input, output, session) { 
    ns <- session$ns
    observeEvent(selector(), {
      choices=data %>%
        filter({{input_val}} %in% selector()) %>%
        distinct({{output_val}}) %>%
        arrange({{output_val}}) %>%
        pull({{output_val}})
      updateVirtualSelect("select", choices = choices, selected = choices)
    }, ignoreNULL = FALSE)
    return(reactive({input$select}))
  })
}

ui_heirarchy <- function(id){
  ns <- NS(id)
  tagList(
    virtualSelectInput(ns("Module0"), label = "Region", choices = sort(unique(state.region)), selected = sort(unique(state.region)), multiple = TRUE),
    moduleUI(ns("Module1"), label = "Division"),
    moduleUI(ns("Module2"), label = "State"),
  )
}

server_heirarchy <- function(id, data) {
  moduleServer(id, function(input, output, session) {
    mod0 <- reactive({input$Module0})
    mod1 <- moduleController("Module1", data, reactive({mod0()}), region, division)
    mod2 <- moduleController("Module2", data, reactive({mod1()}), division, state)
    return(list(mod0 = mod0, mod1 = mod1, mod2 = mod2))
  })
}

# ui / server / app

ui <- fixedPage(
  ui_heirarchy("heirarchy"),
  textOutput("row_n")
)

server <- function(input, output, session) {
  state_info <- data.frame(region = state.region, division = state.division, state = state.name)
  out <- server_heirarchy("heirarchy", state_info)
  y <- reactive({
    req(out$mod2())
    state_info %>%
      filter(region %in% out$mod0()) %>%
      filter(division %in% out$mod1()) %>%
      filter(state %in% out$mod2())
  }) %>%
    debounce(500)
  output$row_n <- renderText({
    as.character(nrow(y()))})
}

shinyApp(ui, server)
pvictor commented 8 months ago

Hi,

the solution for explicitly calling the _open input value adds much complexity when working in a modular workflow.

I'm not sure to understand, in a module you can use input$select_open like you use input$select, why do you need this here ?

I 'll take a look if it's possible to send input vlaue after close rather than on change.

pvictor commented 8 months ago

virtualSelectInput() now has an updateOn = "change" or "close" argument.

dsen6644 commented 8 months ago

Works perfectly, thank you!!

dsen6644 commented 8 months ago

Complete