shinyWidgets

shinyWidgets copied to clipboard

Hello,

When there are some NA in a dataframe, the NA category does not appear in the choices of the selectizeGroup module. This would be nice to have this feature.

I did a modification a couple of years ago to handle the NA, but I don't understand my code anymore... I played with switching between "NA" and NA.

Hello,

The easy way must be to transform NA values to a character "NA". I haven't touched these modules for a while, I wonder about them, maybe I'll migrate them to another package (datamods) and refresh them at the same time.

Victor

Currently NAs are dropped by sort with it's default argument na.last = NA

e.g. here

setting this to na.last = TRUE keeps them until using updateSelectizeInput with server = TRUE

Using server = FALSE keeps the NAs (without making them "NA"):

library(shiny)

ui <- fluidPage(
  selectizeInput("variable1", "Variable:", c("a", "b")),
  selectizeInput("variable2", "Variable:", c("a", "b"))
)

server <- function(input, output, session) {
  updateSelectizeInput(inputId = "variable1", choices = NA, server = TRUE)
  updateSelectizeInput(inputId = "variable2", choices = NA)
}

shinyApp(ui, server)

I found my old code, but I don't understand it anymore. Below it is.

@ismirsehregal Have you tried with the module ? I vaguely remember a situation where the NA appear but then disappear when filtering.

selectizeGroupUI2 <- function(id, params, label = NULL){
  ns <- NS(id)
  selectizeGroupTag <- tagList(
    tags$b(label),
    lapply(X = seq_along(params), FUN = function(x) {
      input <- params[[x]]
      tagSelect <- selectizeInput(
        inputId = ns(input$inputId), width = "100%",
        label = input$title, choices = input$choices,
        selected = input$selected, multiple = TRUE,
        options = list(
          plugins = list("remove_button")
        )
      )
      return(
        div(
          tagSelect,
          div(style="margin-bottom: -25px;"),
          tags$hr(),
          div(style="margin-bottom: -10px;")
        )
      )
    })
  )
  tagList(
    singleton(
      tagList(
        # tags$link(
        #   rel = "stylesheet", type = "text/css",
        #   href = "shinyWidgets/modules/styles-modules.css"
        # ),
        shinyWidgets:::toggleDisplayUi()
      )
    ),
    selectizeGroupTag)
}

usort <- function(x){
  sort(unique(x), na.last = TRUE)
}
selectizeGroupServer2 <- function(id, data, vars){
  moduleServer(
    id,
    function(input, output, session){
      data <- as.data.frame(data)
      data <- dmap_if(data, is.factor, as.character)
      ns <- session$ns
      shinyWidgets:::toggleDisplayServer(
        session = session, id = ns("reset_all"), display = "none"
      )
      lapply(X = vars, FUN = function(x) {
        vals <- usort(data[[x]])
        updateSelectizeInput(
          session = session, inputId = x, choices = vals, server = TRUE
        )
      })
      observeEvent(input$reset_all, {
        lapply(X = vars, FUN = function(x) {
          vals <- usort(data[[x]])
          updateSelectizeInput(
            session = session, inputId = x, choices = vals, server = TRUE
          )
        })
      })
      lapply(X = vars, FUN = function(x) {
        ovars <- vars[vars != x]
        observeEvent(input[[x]], {
          indicator <- lapply(X = vars, FUN = function(x) {
            inputx <- input[[x]]
            if(!is.null(inputx)) inputx[inputx=="NA"] <- NA
            shinyWidgets:::`%inT%`(data[[x]], inputx)
          })
          indicator <- Reduce(f = `&`, x = indicator)
          if(all(indicator)) {
            shinyWidgets:::toggleDisplayServer(
              session = session, id = ns("reset_all"), display = "none"
            )
          }else {
            shinyWidgets:::toggleDisplayServer(
              session = session, id = ns("reset_all"),
              display = "block"
            )
          }
        }, ignoreNULL = FALSE, ignoreInit = TRUE)
      })
      return(
        reactive({
          indicator <- lapply(X = vars, FUN = function(x) {
            inputx <- input[[x]]
            if(!is.null(inputx)) inputx[inputx=="NA"] <- NA
            shinyWidgets:::`%inT%`(data[[x]], inputx)
          })
          indicator <- Reduce(f = `&`, x = indicator)
          data <- data[indicator, ]
          return(data)
        })
      )
    }
  )
}

Ah, this code is incomplete. There's another part in the app. Still trying to understand..

@ismirsehregal is right, this works with server = FALSE (and not removing the NAs when sorting).