feature request: many factor select support server

[Liripo]

This package is great!

When there are many options, such as more than 20000, provide server support. for example: https://shiny.posit.co/r/articles/build/selectize/

Application scenario: For example, if there are some important content, such as gene names, I want to provide a drop-down menu search instead of a text box.

library(shiny)

ui <- fluidPage(
  selectizeInput("test",label = NULL,
                 choices = NULL)
)

server <- function(input, output, session) {
  updateSelectizeInput(inputId = "test",choices = paste0("Gene",1:50000),server = TRUE)
}

shinyApp(ui, server)

[dgkf]

Thanks for the kind words, and for the helpful resource!

My immediate use case never had so many unique factor levels, so that's certainly a use case I never considered! I'll explore it. If it looks reasonably straightforward to add I'll try to get an update pushed out.

I can't make any promises, though, if it looks like it will require a more substantial refactor. With a quick look it seems like a pretty reasonable addition.

[Liripo]

I tried adding the following code in the shiny_vector_filter_factor_many.R and it seems to work fine.

if (length(unique(as.character(xr()))) > 50) {
    # The two contents need to be triggered jointly，UI 与 update
    ui_update <- reactiveVal(FALSE)
    output$ui <- shiny::renderUI({
      # shiny::selectizeInput(ns("param"),
      #   label = NULL,
      #   choices = NULL,
      #   selected = shiny::isolate(input$param) %||% c(),
      #   multiple = TRUE,
      #   width = "100%"
      # )
      ui_update(TRUE)
      proportionSelectInput(ns("param"),
        NULL,
        vec = NULL,
        selected = shiny::isolate(input$param) %||% c(),
        multiple = TRUE,
        width = "100%"
      )
    })

    observeEvent(ui_update(),{
      if (isTRUE(ui_update())) {
        vecr_counts <- sort(table(xr()), decreasing = TRUE) |> 
          as.data.frame()
        colnames(vecr_counts) <- c("name","count")
        vecr_counts$prop <- vecr_counts$count/sum(vecr_counts$count)

        labels <- sprintf('{
        "name": "%s",
        "prop": %f,
        "count": %d
      }',vecr_counts$name,vecr_counts$prop,vecr_counts$count)

        choices <- as.list(as.character(vecr_counts$name))
        names(choices) <- labels

        updateSelectizeInput(
          session = session,
          inputId = "param",
          choices = choices,
          server = TRUE
        )
        ui_update(FALSE)
      }
    })
  } else {
    output$ui <- shiny::renderUI({
      proportionSelectInput(ns("param"), NULL,
        vec = x,
        selected = shiny::isolate(input$param) %||% c(),
        multiple = TRUE,
        width = "100%"
      )
    })
  }

[dgkf]

This is awesome! Do you want to contribute it as a PR?

Instead of putting the if else inside of shiny_vector_filter_factor_many.R, though, I would suggest breaking it out as a new function to be used here:

https://github.com/dgkf/shinyDataFilter/blob/68d20f554211e722aafbb8272ccbf8342a0aad10/R/shiny_vector_filter_factor.R#L10-L16

   #' @export 
   shiny_vector_filter.factor <- function(data, inputId, ...) { 
+    if (length(unique(as.character(data))) > 50)
+      shiny_vector_filter_factor_server_side
     if (length(unique(as.character(data))) > 5) 
       shiny_vector_filter_factor_many 
     else 
       shiny_vector_filter_factor_few 
   } 

Otherwise this looks like a great start.

[Liripo]

Ok, I'll try to make a PR if follow-up testing is well.