diff --git a/R/FilterStateChoices.R b/R/FilterStateChoices.R index 477e8bad9..e47104a4d 100644 --- a/R/FilterStateChoices.R +++ b/R/FilterStateChoices.R @@ -177,8 +177,6 @@ ChoicesFilterState <- R6::R6Class( # nolint if (inherits(x, "POSIXt")) { private$tzone <- Find(function(x) x != "", attr(as.POSIXlt(x), "tzone")) } - - private$set_choices_counts(unname(table(x))) }) invisible(self) }, @@ -242,11 +240,13 @@ ChoicesFilterState <- R6::R6Class( # nolint # Checks validity of the choices, adjust if neccessary and sets the flag for the case where choices # are limited by default from the start. set_choices = function(choices) { + ordered_counts <- .table(private$x) + possible_choices <- names(ordered_counts) if (is.null(choices)) { - choices <- unique(as.character(na.omit(private$x))) + choices <- possible_choices } else { choices <- as.character(choices) - choices_adjusted <- choices[choices %in% unique(private$x)] + choices_adjusted <- choices[choices %in% possible_choices] if (length(setdiff(choices, choices_adjusted)) > 0L) { warning( sprintf( @@ -263,13 +263,12 @@ ChoicesFilterState <- R6::R6Class( # nolint private$get_id() ) ) - choices <- levels(private$x) + choices <- possible_choices } } - private$set_is_choice_limited(private$x, choices) + private$set_choices_counts(unname(ordered_counts[choices])) + private$set_is_choice_limited(possible_choices, choices) private$teal_slice$choices <- choices - private$x <- private$x[(private$x %in% private$get_choices()) | is.na(private$x)] - if (is.factor(private$x)) private$x <- droplevels(private$x) invisible(NULL) }, # @description @@ -286,15 +285,6 @@ ChoicesFilterState <- R6::R6Class( # nolint invisible(NULL) }, # @description - # Checks how many counts of each choice is present in the data. - get_choices_counts = function() { - if (!is.null(private$x_reactive)) { - table(factor(private$x_reactive(), levels = private$get_choices())) - } else { - NULL - } - }, - # @description # Checks whether the input should be rendered as a checkboxgroup/radiobutton or a drop-down. is_checkboxgroup = function() { length(private$get_choices()) <= getOption("teal.threshold_slider_vs_checkboxgroup") @@ -345,7 +335,9 @@ ChoicesFilterState <- R6::R6Class( # nolint isolate({ countsmax <- private$choices_counts countsnow <- if (!is.null(private$x_reactive())) { - unname(table(factor(private$x_reactive(), levels = private$get_choices()))) + unname( + .table(private$x_reactive())[private$get_choices()] + ) } ui_input <- if (private$is_checkboxgroup()) { @@ -423,7 +415,9 @@ ChoicesFilterState <- R6::R6Class( # nolint logger::log_trace("ChoicesFilterState$server_inputs@1 updating count labels, id: { private$get_id() }") countsnow <- if (!is.null(private$x_reactive())) { - unname(table(factor(non_missing_values(), levels = private$get_choices()))) + unname( + .table(non_missing_values())[private$get_choices()] + ) } # update should be based on a change of counts only @@ -548,7 +542,9 @@ ChoicesFilterState <- R6::R6Class( # nolint output$selection <- renderUI({ countsnow <- if (!is.null(private$x_reactive())) { - unname(table(factor(private$x_reactive(), levels = private$get_choices()))) + unname( + .table(private$x_reactive())[private$get_choices()] + ) } countsmax <- private$choices_counts @@ -598,3 +594,19 @@ ChoicesFilterState <- R6::R6Class( # nolint } ) ) + +#' `table` handling `POSIXlt` +#' +#' @param x (`vector`) variable to get counts from. +#' @return vector of counts named by unique values of `x`. +#' +#' @keywords internal +.table <- function(x) { + table( + if (is.factor(x)) { + x + } else { + as.character(x) + } + ) +} diff --git a/man/dot-table.Rd b/man/dot-table.Rd new file mode 100644 index 000000000..3be759589 --- /dev/null +++ b/man/dot-table.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/FilterStateChoices.R +\name{.table} +\alias{.table} +\title{\code{table} handling \code{POSIXlt}} +\usage{ +.table(x) +} +\arguments{ +\item{x}{(\code{vector}) variable to get counts from.} +} +\value{ +vector of counts named by unique values of \code{x}. +} +\description{ +\code{table} handling \code{POSIXlt} +} +\keyword{internal}