conflict resolution (#197)

Merging `main` branch into `filter_panel_refactor`  following #189.

---------

Co-authored-by: chlebowa <chlebowa@users.noreply.github.com>
Co-authored-by: Dawid Kałędkowski <dawid.kaledkowski@gmail.com>

Author: chlebowa

NEWS.md

@@ -17,6 +17,7 @@
 ### Bug fixes
 
 * Fixed an error where the `RangeFilterState` produced an error when using `bootstrap 4`.
+* Fixed a bug that caused the range slider to omit values selected programmatically through the filter API.
 
 ### Miscellaneous
 

R/FilterState-utils.R

@@ -265,7 +265,7 @@ init_filter_state.POSIXlt <- function(x,
 #' @keywords internal
 #'
 #' @examples
-#' \dontrun{
+#' \donttest{
 #' check_in_range(c(3, 1), c(1, 3))
 #' check_in_range(c(0, 3), c(1, 3))
 #' check_in_range(
@@ -313,13 +313,15 @@ check_in_range <- function(subinterval, range, pre_msg = "") {
 #' @keywords internal
 #'
 #' @examples
-#' check_in_subset <- teal.slice:::check_in_subset
+#' \donttest{
+#' check_in_subset <- check_in_subset
 #' check_in_subset(c("a", "b"), c("a", "b", "c"))
 #' \dontrun{
 #' check_in_subset(c("a", "b"), c("b", "c"), pre_msg = "Error: ")
 #' # truncated because too long
 #' check_in_subset("a", LETTERS, pre_msg = "Error: ")
 #' }
+#' }
 check_in_subset <- function(subset, choices, pre_msg = "") {
   checkmate::assert_string(pre_msg)
 
@@ -336,3 +338,46 @@ check_in_subset <- function(subset, choices, pre_msg = "") {
   }
   return(invisible(NULL))
 }
+
+#' Find containing limits for interval.
+#'
+#' Given an interval and a numeric vector,
+#' find the smallest interval within the numeric vector that contains the interval.
+#'
+#' This is a helper function for `RangeFilterState` that modifies slider selection
+#' so that the _subsetting call_ includes the value specified by the filter API call.
+#'
+#' Regardless of the underlying numeric data, the slider always presents 100 steps.
+#' The ticks on the slider do not represent actual observations but rather borders between virtual bins.
+#' Since the value selected on the slider is passed to `private$selected` and that in turn
+#' updates the slider selection, programmatic selection of arbitrary values may inadvertently shift
+#' the selection to the closest tick, thereby dropping the actual value set (if it exists in the data).
+#'
+#' This function purposely shifts the selection to the closest ticks whose values form an interval
+#' that will contain the interval defined by the filter API call.
+#'
+#' @param x `numeric(2)` interval to contain
+#' @param range `numeric(>=2)` vector of values to contain `x` in
+#'
+#' @return Numeric vector of length 2 that lies within `range`.
+#'
+#' @keywords internal
+#'
+#' @examples
+#' \donttest{
+#' ticks <- 1:10
+#' values1 <- c(3, 5)
+#' contain_interval(values1, ticks)
+#' values2 <- c(3.1, 5.7)
+#' contain_interval(values2, ticks)
+#' values3 <- c(0, 20)
+#' contain_interval(values3, ticks)
+#'}
+contain_interval <- function(x, range) {
+  checkmate::assert_numeric(x, len = 2L, any.missing = FALSE, sorted = TRUE)
+  checkmate::assert_numeric(range, min.len = 2L, any.missing = FALSE, sorted = TRUE)
+
+  x[1] <- Find(function(i) i <= x[1], range, nomatch = min(range), right = TRUE)
+  x[2] <- Find(function(i) i >= x[2], range, nomatch = max(range))
+  x
+}

R/FilterState.R

@@ -2,7 +2,9 @@
 #' @docType class
 #'
 #'
-#' @title Abstract class to encapsulate filter states
+#' @title FilterState Abstract Class
+#'
+#' @description Abstract class to encapsulate filter states
 #'
 #' @details
 #' This class is responsible for managing single filter item within
@@ -288,7 +290,7 @@ FilterState <- R6::R6Class( # nolint
     #' @param value (`vector`)\cr
     #'   value(s) that come from filter selection; values are set in the
     #'   module server after a selection is made in the app interface;
-    #'   values are stored in `private$selected`n which is reactive;
+    #'   values are stored in `private$selected` which is reactive;
     #'   value types have to be the same as `private$choices`
     #'
     #' @return NULL invisibly
@@ -430,11 +432,12 @@ FilterState <- R6::R6Class( # nolint
     x_reactive = NULL, # reactive containing the filtered variable, used for updating counts and histograms
     filtered_na_count = NULL, # reactive containing the count of NA in the filtered dataset
 
-    #' description
-    #' Adds `is.na(varname)` before existing condition calls if `keep_na` is selected.
-    #' Otherwise, if missings are found in the variable `!is.na` will be added
-    #' only if `private$na_rm = TRUE`
-    #' return (`call`)
+    # private methods ----
+    # @description
+    # Adds `is.na(varname)` before existing condition calls if `keep_na` is selected.
+    # Otherwise, if missings are found in the variable `!is.na` will be added
+    # only if `private$na_rm = TRUE`
+    # @return (`call`)
     add_keep_na_call = function(filter_call) {
       if (isTRUE(self$get_keep_na())) {
         call(
@@ -453,14 +456,14 @@ FilterState <- R6::R6Class( # nolint
       }
     },
 
-    #' description
-    #' Prefixed (or not) variable
-    #'
-    #' Return variable name needed to condition call.
-    #' If `isTRUE(private$use_dataset)` variable is prefixed by
-    #' dataname to be evaluated as extracted object, for example
-    #' `data$var`
-    #' return (`name` or `call`)
+    # @description
+    # Prefixed (or not) variable
+    #
+    # Return variable name needed to condition call.
+    # If `isTRUE(private$use_dataset)` variable is prefixed by
+    # dataname to be evaluated as extracted object, for example
+    # `data$var`
+    # @return (`name` or `call`)
     get_varname_prefixed = function() {
       if (isTRUE(private$extract_type == "list")) {
         call_extract_list(private$dataname, private$varname)
@@ -474,13 +477,20 @@ FilterState <- R6::R6Class( # nolint
       }
     },
 
-    #' Set choices
-    #'
-    #' Set choices is supposed to be executed once in the constructor
-    #' to define set/range which selection is made from.
-    #' parameter choices (`vector`)\cr
-    #'  class of the vector depends on the `FilterState` class.
-    #' return a `NULL`
+
+    # Sets `keep_na` field according to observed `input$keep_na`
+    # If `keep_na = TRUE` `is.na(varname)` is added to the returned call.
+    # Otherwise returned call excludes `NA` when executed.
+    observe_keep_na = function(input) {
+
+    },
+
+    # @description
+    # Set choices is supposed to be executed once in the constructor
+    # to define set/range which selection is made from.
+    # parameter choices (`vector`)\cr
+    #  class of the vector depends on the `FilterState` class.
+    # @return `NULL`
     set_choices = function(choices) {
       private$choices <- choices
       invisible(NULL)
@@ -528,11 +538,11 @@ FilterState <- R6::R6Class( # nolint
     },
 
     # shiny modules -----
-    #' module with inputs
+    # module with inputs
     ui_inputs = function(id) {
       stop("abstract class")
     },
-    #' module with inputs
+    # module with inputs
     server_inputs = function(id) {
       stop("abstract class")
     },
@@ -589,7 +599,7 @@ FilterState <- R6::R6Class( # nolint
           }
         )
         private$observers$keep_na <- observeEvent(
-          ignoreNULL = FALSE, # ignoreNULL: we don't want to ignore NULL when nothing is selected in the `selectInput`,
+          ignoreNULL = FALSE, # ignoreNULL: we don't want to ignore NULL when nothing is selected in the `selectInput`
           ignoreInit = TRUE, # ignoreInit: should not matter because we set the UI with the desired initial state
           eventExpr = input$value,
           handlerExpr = {

R/FilterStateChoices.R

@@ -18,6 +18,9 @@
 ChoicesFilterState <- R6::R6Class( # nolint
   "ChoicesFilterState",
   inherit = FilterState,
+
+  # public methods ----
+
   public = list(
 
     #' @description
@@ -139,8 +142,13 @@ ChoicesFilterState <- R6::R6Class( # nolint
       super$set_selected(value)
     }
   ),
+
+  # private members ----
+
   private = list(
     histogram_data = data.frame(),
+
+    # private methods ----
     validate_selection = function(value) {
       if (!is.character(value)) {
         stop(
@@ -229,6 +237,8 @@ ChoicesFilterState <- R6::R6Class( # nolint
       }
     },
 
+    # shiny modules ----
+
     # @description
     # UI Module for `ChoicesFilterState`.
     # This UI element contains available choices selection and

R/FilterStateDate.R

@@ -19,6 +19,9 @@
 DateFilterState <- R6::R6Class( # nolint
   "DateFilterState",
   inherit = FilterState,
+
+  # public methods ----
+
   public = list(
 
     #' @description
@@ -70,12 +73,13 @@ DateFilterState <- R6::R6Class( # nolint
     format = function(indent = 0) {
       checkmate::assert_number(indent, finite = TRUE, lower = 0)
 
+      vals <- self$get_selected()
       sprintf(
         "%sFiltering on: %s\n%1$s  Selected range: %s - %s\n%1$s  Include missing values: %s",
         format("", width = indent),
         private$varname,
-        format(self$get_selected()[1], nsmall = 3),
-        format(self$get_selected()[2], nsmall = 3),
+        format(vals[1], nsmall = 3),
+        format(vals[2], nsmall = 3),
         format(self$get_keep_na())
       )
     },
@@ -132,6 +136,9 @@ DateFilterState <- R6::R6Class( # nolint
       super$set_selected(value)
     }
   ),
+
+  # private methods ----
+
   private = list(
     validate_selection = function(value) {
       if (!is(value, "Date")) {
@@ -180,6 +187,8 @@ DateFilterState <- R6::R6Class( # nolint
       values
     },
 
+    # shiny modules ----
+
     # @description
     # UI Module for `DateFilterState`.
     # This UI element contains two date selections for `min` and `max`

R/FilterStateDatettime.R

@@ -19,6 +19,9 @@
 DatetimeFilterState <- R6::R6Class( # nolint
   "DatetimeFilterState",
   inherit = FilterState,
+
+  # public methods ----
+
   public = list(
 
     #' @description
@@ -82,12 +85,15 @@ DatetimeFilterState <- R6::R6Class( # nolint
     #'
     format = function(indent = 0) {
       checkmate::assert_number(indent, finite = TRUE, lower = 0)
+
+
+      vals <- self$get_selected()
       sprintf(
         "%sFiltering on: %s\n%1$s  Selected range: %s - %s\n%1$s  Include missing values: %s",
         format("", width = indent),
         private$varname,
-        format(self$get_selected(), nsmall = 3)[1],
-        format(self$get_selected(), nsmall = 3)[2],
+        format(vals[1], nsmall = 3),
+        format(vals[2], nsmall = 3),
         format(self$get_keep_na())
       )
     },
@@ -144,8 +150,14 @@ DatetimeFilterState <- R6::R6Class( # nolint
       super$set_selected(value)
     }
   ),
+
+  # private fields ----
+
   private = list(
     timezone = Sys.timezone(),
+
+    # private methods ----
+
     validate_selection = function(value) {
       if (!(is(value, "POSIXct") || is(value, "POSIXlt"))) {
         stop(
@@ -194,6 +206,8 @@ DatetimeFilterState <- R6::R6Class( # nolint
       values
     },
 
+    # shiny modules ----
+
     # @description
     # UI Module for `DatetimeFilterState`.
     # This UI element contains two date-time selections for `min` and `max`

R/FilterStateLogical.R

@@ -19,6 +19,8 @@
 LogicalFilterState <- R6::R6Class( # nolint
   "LogicalFilterState",
   inherit = FilterState,
+
+  # public methods ----
   public = list(
 
     #' @description
@@ -126,8 +128,14 @@ LogicalFilterState <- R6::R6Class( # nolint
       super$set_selected(value)
     }
   ),
+
+  # private fields ----
+
   private = list(
     histogram_data = data.frame(),
+
+    # private methods ----
+
     validate_selection = function(value) {
       if (!(checkmate::test_logical(value, max.len = 1, any.missing = FALSE))) {
         stop(
@@ -187,6 +195,9 @@ LogicalFilterState <- R6::R6Class( # nolint
       })
     },
 
+
+    # shiny modules ----
+
     # @description
     # UI Module for `EmptyFilterState`.
     # This UI element contains available choices selection and