diff --git a/.lintr b/.lintr index 34473d27..fff47977 100644 --- a/.lintr +++ b/.lintr @@ -1,5 +1,6 @@ linters: linters_with_defaults( line_length_linter = line_length_linter(120), cyclocomp_linter = NULL, - object_usage_linter = NULL + object_usage_linter = NULL, + object_name_linter = object_name_linter(styles = c("snake_case", "symbols"), regexes = c(ANL = "^ANL_?[0-9]*$", ADaM = "^r?AD[A-Z]{2,3}_?[0-9]*$")) ) diff --git a/R/Queue.R b/R/Queue.R index 4709a267..17f56fce 100644 --- a/R/Queue.R +++ b/R/Queue.R @@ -1,27 +1,32 @@ # Queue ==== -#' @title R6 Class - A First-In-First-Out Abstract Data Type +#' R6 Class - A First-In-First-Out Abstract Data Type +#' @docType class +#' +#' @description +#' `r lifecycle::badge("experimental")` #' -#' @description `r lifecycle::badge("experimental")`\cr #' Abstract data type that stores and returns any number of elements. #' +#' @details #' A `Queue` object stores all elements in a single vector, #' thus all data types can be stored, but silent coercion may occur. #' #' Elements are returned in the same order that they were added. #' +#' @name Queue #' @keywords internal #' -Queue <- R6::R6Class( # nolint +Queue <- R6::R6Class( # nolint: object_name_linter. classname = "Queue", # public methods ---- public = list( #' @description #' Adds element(s) to `Queue`. #' - #' @param new_elements vector of elements to add + #' @param new_elements vector of elements to add. #' - #' @return self invisibly + #' @return `self`, invisibly. #' push = function(new_elements) { for (i in seq_along(new_elements)) { @@ -34,7 +39,7 @@ Queue <- R6::R6Class( # nolint #' @description #' Returns all contents of the `Queue` object. #' - #' @return single vector containing all `Queue` contents + #' @return Single vector containing all `Queue` contents. #' get = function() { private$array @@ -42,8 +47,8 @@ Queue <- R6::R6Class( # nolint #' @description #' Returns the first (oldest) element of the `Queue` and removes it. #' - #' @return - #' vector of length 1 containing the first element of `Queue` or NULL if `Queue` is empty + #' @return vector of length 1 containing the first element of `Queue` + #' or `NULL` if `Queue` is empty. #' pop = function() { returned_element <- self$get()[1L] @@ -54,9 +59,9 @@ Queue <- R6::R6Class( # nolint #' Removes the oldest occurrence of specified element(s) from `Queue`. #' Relies on implicit type conversions of R identify elements to remove. #' - #' @param elements vector of elements to remove from `Queue` + #' @param elements vector of elements to remove from `Queue`. #' - #' @return self invisibly + #' @return `self`, invisibly. #' remove = function(elements) { for (el in elements) { @@ -68,7 +73,7 @@ Queue <- R6::R6Class( # nolint #' @description #' Removes all elements from `Queue`. #' - #' @return self invisibly + #' @return `self`, invisibly. #' empty = function() { private$array <- c() @@ -77,7 +82,7 @@ Queue <- R6::R6Class( # nolint #' @description #' Returns the number of elements in `Queue`. #' - #' @return integer of length 1 + #' @return `integer(1)`. #' size = function() { length(self$get()) @@ -85,9 +90,9 @@ Queue <- R6::R6Class( # nolint #' @description #' Prints this `Queue`. #' - #' @param ... additional arguments to this method, ignored + #' @param ... Additional arguments to this method, ignored. #' - #' @return invisibly self + #' @return `self`, invisibly. print = function(...) { cat( sprintf( diff --git a/R/all_choices.R b/R/all_choices.R index c4a112ca..c6e69f38 100644 --- a/R/all_choices.R +++ b/R/all_choices.R @@ -1,9 +1,12 @@ -#' An S3 structure representing the selection of all -#' possible choices in a `filter_spec`, `select_spec` or `choices_selected` object. +#' Bare constructor for `all_choices` object #' -#' @description `r lifecycle::badge("experimental")` +#' @description +#' `r lifecycle::badge("experimental")` #' -#' @return `all_choices` object +#' An S3 structure representing the selection of all possible choices in a +#' `filter_spec`, `select_spec` or `choices_selected` object. +#' +#' @return `all_choices` object. #' #' @examples #' # Both structures are semantically identical @@ -22,6 +25,7 @@ #' choices_selected(choices = letters, selected = letters) #' choices_selected(choices = letters, selected = all_choices()) #' @export +#' all_choices <- function() { structure(list(), class = "all_choices") } diff --git a/R/call_utils.R b/R/call_utils.R index 9b3bbd24..67aaf6a3 100644 --- a/R/call_utils.R +++ b/R/call_utils.R @@ -1,9 +1,14 @@ #' Checks `varname` argument and convert to call #' -#' Checks `varname` type and parse if it's a `character` -#' @param varname (`name`, `call` or `character(1)`)\cr -#' name of the variable +#' Checks `varname` type and parse if it's a `character`. +#' +#' @param varname (`name` or `call` or `character(1)`) +#' name of the variable +#' +#' @returns the parsed `varname`. +#' #' @keywords internal +#' call_check_parse_varname <- function(varname) { checkmate::assert( checkmate::check_string(varname), @@ -30,33 +35,39 @@ call_check_parse_varname <- function(varname) { #' #' Compose choices condition call from inputs. #' -#' @param varname (`name`, `call` or `character(1)`)\cr -#' name of the variable -#' -#' @param choices (`vector`)\cr -#' `varname` values to match using the `==` (single value) or -#' `%in%` (vector) condition. `choices` can be vector of any type -#' but for some output might be converted: -#' \itemize{ -#' \item{`factor`}{ call is composed on choices converted to `character`} -#' \item{`Date`}{ call is composed on choices converted to `character` using `format(choices)`} -#' \item{`POSIXct`, `POSIXlt`}{ Call is composed on choices converted to `character` using -#' `format(choices)`. One has to be careful here as formatted date-time variable might loose -#' some precision (see `format` argument in \code{\link{format.POSIXlt}}) and output call -#' could be insufficient for exact comparison. In this case one should specify -#' `varname = trunc()` and possibly convert `choices` to `character`) -#' } -#' } +#' @details +#' `choices` can be vector of any type but for some output might be converted: +#' * `factor` call is composed on choices converted to `character`; +#' * `Date` call is composed on choices converted to `character` using +#' `format(choices)`; +#' * `POSIXct`, `POSIXlt` call is composed on choices converted to `character` using +#' `format(choices)`. +#' +#' One has to be careful here as formatted date-time variable might loose +#' some precision (see `format` argument in [format.POSIXlt()] and output call +#' could be insufficient for exact comparison. In this case one should specify +#' `varname = trunc()` and possibly convert `choices` to `character`). +#' +#' @param varname (`name` or `call` or `character(1)`) +#' name of the variable. +#' @param choices (`vector`) +#' `varname` values to match using the `==` (single value) or `%in%` (vector) +#' condition. +#' +#' @return `call`. #' #' @examples -#' teal.transform:::call_condition_choice("SEX", choices = c(1, 2)) -#' teal.transform:::call_condition_choice(as.name("SEX"), choices = "F") -#' teal.transform:::call_condition_choice("SEX", choices = c("F", "M")) -#' teal.transform:::call_condition_choice("SEX", choices = factor(c("F", "M"))) -#' teal.transform:::call_condition_choice("x$SEX", choices = Sys.Date()) -#' teal.transform:::call_condition_choice("trunc(x$SEX)", choices = Sys.time()) -#' @return a `call` +#' # use non-exported function from teal.transform +#' call_condition_choice <- getFromNamespace("call_condition_choice", "teal.transform") +#' +#' call_condition_choice("SEX", choices = c(1, 2)) +#' call_condition_choice(as.name("SEX"), choices = "F") +#' call_condition_choice("SEX", choices = c("F", "M")) +#' call_condition_choice("SEX", choices = factor(c("F", "M"))) +#' call_condition_choice("x$SEX", choices = Sys.Date()) +#' call_condition_choice("trunc(x$SEX)", choices = Sys.time()) #' @keywords internal +#' call_condition_choice <- function(varname, choices) { varname <- call_check_parse_varname(varname) @@ -85,24 +96,29 @@ call_condition_choice <- function(varname, choices) { #' `numeric` range condition call #' -#' Compose `numeric` range condition call from inputs +#' Compose `numeric` range condition call from inputs. #' -#' @param varname (`name` or `character(1)`)\cr -#' name of the variable +#' @param varname (`name` or `character(1)`) +#' name of the variable. #' -#' @param range (`numeric(2)`)\cr -#' range of the variable +#' @param range (`numeric(2)`) +#' range of the variable. +#' +#' @return `call`. #' -#' @return call #' @examples -#' teal.transform:::call_condition_range("AGE", range = c(1, 2)) -#' teal.transform:::call_condition_range(as.name("AGE"), range = c(-1.2, 2.1)) -#' teal.transform:::call_condition_range( -#' teal.transform:::call_extract_list("ADSL", "AGE"), +#' # use non-exported function from teal.transform +#' call_condition_range <- getFromNamespace("call_condition_range", "teal.transform") +#' call_extract_list <- getFromNamespace("call_extract_list", "teal.transform") +#' +#' call_condition_range("AGE", range = c(1, 2)) +#' call_condition_range(as.name("AGE"), range = c(-1.2, 2.1)) +#' call_condition_range( +#' call_extract_list("ADSL", "AGE"), #' range = c(-1.2, 2.1) #' ) -#' @return a `call` #' @keywords internal +#' call_condition_range <- function(varname, range) { checkmate::assert_numeric(range, len = 2, sorted = TRUE) @@ -116,20 +132,24 @@ call_condition_range <- function(varname, range) { #' `logical` variable condition call #' -#' Compose `logical` variable condition call from inputs +#' Compose `logical` variable condition call from inputs. #' -#' @param varname (`name` or `character(1)`)\cr -#' name of the variable +#' @param varname (`name` or `character(1)`) +#' name of the variable #' -#' @param choice (`logical(1)`)\cr -#' chosen value +#' @param choice (`logical(1)`) +#' chosen value +#' +#' @return `call`. #' -#' @return call #' @examples -#' teal.transform:::call_condition_logical("event", choice = TRUE) -#' teal.transform:::call_condition_logical("event", choice = FALSE) -#' @return a `call` +#' # use non-exported function from teal.transform +#' call_condition_logical <- getFromNamespace("call_condition_logical", "teal.transform") +#' +#' call_condition_logical("event", choice = TRUE) +#' call_condition_logical("event", choice = FALSE) #' @keywords internal +#' call_condition_logical <- function(varname, choice) { checkmate::assert_flag(choice) varname <- call_check_parse_varname(varname) @@ -146,31 +166,32 @@ call_condition_logical <- function(varname, choice) { } } - #' `POSIXct` range condition call #' #' Compose `POSIXct` range condition call from inputs. #' -#' @param varname (`name` or `character(1)`)\cr -#' name of the variable -#' -#' @param range (`POSIXct`)\cr -#' range of the variable. Be aware that output -#' uses truncated range format `"%Y-%m-%d %H:%M:%S"`, which means that -#' some precision might be lost. +#' @param varname (`name` or `character(1)`) name of the variable. +#' @param range (`POSIXct`) range of the variable. +#' Be aware that output uses truncated range format `"%Y-%m-%d %H:%M:%S"`, +#' which means that some precision might be lost. +#' @param timezone (`character(1)`) specifies the time zone to be used for the conversion. +#' By default `Sys.timezone()` is used. #' -#' @param timezone (`character(1)`)\cr -#' specifies the time zone to be used for the conversion. -#' By default `Sys.timezone()` is used. +#' @return `call`. #' #' @examples -#' teal.transform:::call_condition_range_posixct( +#' # use non-exported function from teal.transform +#' call_condition_range_posixct <- getFromNamespace( +#' "call_condition_range_posixct", "teal.transform" +#' ) +#' +#' call_condition_range_posixct( #' varname = as.name("datetime"), #' range = c(Sys.time(), Sys.time() + 1), #' timezone = "UTC" #' ) -#' @return a `call` #' @keywords internal +#' call_condition_range_posixct <- function(varname, range, timezone = Sys.timezone()) { checkmate::assert_posixct(range, len = 2, sorted = TRUE) checkmate::assert_string(timezone) @@ -194,21 +215,23 @@ call_condition_range_posixct <- function(varname, range, timezone = Sys.timezone #' `Date` range condition call #' -#' Compose `Date` range condition call from inputs +#' Compose `Date` range condition call from inputs. #' -#' @param varname (`name` or `character(1)`)\cr -#' name of the variable +#' @param varname (`name` or `character(1)`) name of the variable. +#' @param range (`Date`) range of the variable. #' -#' @param range (`Date`)\cr -#' range of the variable +#' @return `call`. #' #' @examples -#' teal.transform:::call_condition_range_date( +#' # use non-exported function from teal.transform +#' call_condition_range_date <- getFromNamespace("call_condition_range_date", "teal.transform") +#' +#' call_condition_range_date( #' as.name("date"), #' range = c(Sys.Date(), Sys.Date() + 1) #' ) -#' @return a `call` #' @keywords internal +#' call_condition_range_date <- function(varname, range) { checkmate::assert_date(range, len = 2) checkmate::assert_true(range[2] >= range[1]) @@ -223,28 +246,33 @@ call_condition_range_date <- function(varname, range) { #' Get call to subset and select array #' -#' Get call to subset and select array -#' @param dataname (`character(1)` or `name`)\cr -#' @param row (`name`, `call`, `logical`, `integer`, `character`)\cr -#' optional, name of the `row` or condition -#' @param column (`name`, `call`, `logical`, `integer`, `character`)\cr -#' optional, name of the `column` or condition -#' @param aisle (`name`, `call`, `logical`, `integer`, `character`)\cr -#' optional, name of the `row` or condition -#' @return `[` call with all conditions included +#' @param dataname (`character(1)` or `name`). +#' @param row (optional `name` or `call` or `logical` or `integer` or `character`) +#' name of the `row` or condition. +#' @param column (optional `name` or `call` or `logical`, `integer` or `character`) +#' name of the `column` or condition. +#' @param aisle (optional `name` or `call` or `logical` or `integer` or `character`) +#' name of the `row` or condition. +#' +#' @return [Extract()] `call` for 3-dimensional array in `x[i, j, k]` notation. +#' #' @examples -#' teal.transform:::call_extract_array( +#' # use non-exported function from teal.transform +#' call_extract_array <- getFromNamespace("call_extract_array", "teal.transform") +#' call_condition_choice <- getFromNamespace("call_condition_choice", "teal.transform") +#' +#' call_extract_array( #' dataname = "my_array", -#' row = teal.transform:::call_condition_choice("my_array$SEX", "M"), +#' row = call_condition_choice("my_array$SEX", "M"), #' column = call("c", "SEX", "AGE"), #' aisle = "RNAseq_rnaaccess" #' ) -#' teal.transform:::call_extract_array( +#' call_extract_array( #' "mae_object", -#' column = teal.transform:::call_condition_choice("SEX", "M") +#' column = call_condition_choice("SEX", "M") #' ) -#' @return specific \code{\link[base]{Extract}} `call` for 3-dimensional array #' @keywords internal +#' call_extract_array <- function(dataname = ".", row = NULL, column = NULL, aisle = NULL) { checkmate::assert( checkmate::check_string(dataname), @@ -283,25 +311,30 @@ call_extract_array <- function(dataname = ".", row = NULL, column = NULL, aisle #' Get call to subset and select matrix #' -#' Get call to subset and select matrix -#' @param dataname (`character(1)` or `name`)\cr -#' @param row (`name`, `call`, `logical`, `integer`, `character`)\cr -#' optional, name of the `row` or condition -#' @param column (`name`, `call`, `logical`, `integer`, `character`)\cr -#' optional, name of the `column` or condition -#' @return `[` call with all conditions included +#' @param dataname (`character(1)` or `name`). +#' @param row (optional `name` or `call` or `logical` or `integer` or `character`) +#' name of the `row` or condition. +#' @param column (optional `name` or `call` or `logical` or `integer` or `character`) +#' name of the `column` or condition. +#' +#' @return [Extract()] `call` for matrix in `x[i, j]` notation. +#' #' @examples -#' teal.transform:::call_extract_matrix( +#' # use non-exported function from teal.transform +#' call_extract_matrix <- getFromNamespace("call_extract_matrix", "teal.transform") +#' call_condition_choice <- getFromNamespace("call_condition_choice", "teal.transform") +#' +#' call_extract_matrix( #' dataname = "my_array", -#' row = teal.transform:::call_condition_choice("my_array$SEX", "M"), +#' row = call_condition_choice("my_array$SEX", "M"), #' column = call("c", "SEX", "AGE") #' ) -#' teal.transform:::call_extract_matrix( +#' call_extract_matrix( #' "mae_object", -#' column = teal.transform:::call_condition_choice("SEX", "M") +#' column = call_condition_choice("SEX", "M") #' ) -#' @return specific \code{\link[base]{Extract}} `call` for matrix #' @keywords internal +#' call_extract_matrix <- function(dataname = ".", row = NULL, column = NULL) { checkmate::assert( checkmate::check_string(dataname), @@ -335,25 +368,23 @@ call_extract_matrix <- function(dataname = ".", row = NULL, column = NULL) { #' Compose extract call with `$` operator #' -#' Compose extract call with `$` operator -#' -#' @param dataname (`character(1)` or `name`)\cr -#' name of the object -#' -#' @param varname (`character(1)` or `name`)\cr -#' name of the slot in data +#' @param dataname (`character(1)` or `name`) name of the object. +#' @param varname (`character(1)` or `name`) name of the slot in data. +#' @param dollar (`logical(1)`) whether returned call should use `$` or `[[` operator. #' -#' @param dollar (`logical(1)`)\cr -#' whether returned call should use `$` or `[[` operator +#' @return [Extract()] `call` in `$` or `[[` notation (depending on parameters). #' -#' @return `$` or `[[` call #' @examples -#' teal.transform:::call_extract_list("ADSL", "SEX") -#' teal.transform:::call_extract_list("ADSL", "named element") -#' teal.transform:::call_extract_list(as.name("ADSL"), as.name("AGE")) -#' teal.transform:::call_extract_list(as.name("weird name"), as.name("AGE")) -#' teal.transform:::call_extract_list(as.name("ADSL"), "AGE", dollar = FALSE) +#' # use non-exported function from teal.transform +#' call_extract_list <- getFromNamespace("call_extract_list", "teal.transform") +#' +#' call_extract_list("ADSL", "SEX") +#' call_extract_list("ADSL", "named element") +#' call_extract_list(as.name("ADSL"), as.name("AGE")) +#' call_extract_list(as.name("weird name"), as.name("AGE")) +#' call_extract_list(as.name("ADSL"), "AGE", dollar = FALSE) #' @keywords internal +#' call_extract_list <- function(dataname, varname, dollar = TRUE) { checkmate::assert_flag(dollar) checkmate::assert( @@ -377,32 +408,34 @@ call_extract_list <- function(dataname, varname, dollar = TRUE) { #' Create a call using a function in a given namespace #' -#' The arguments in ... need to be quoted because they will be evaluated otherwise +#' The dot arguments in `...` need to be quoted because they will be evaluated otherwise. #' -#' @md #' @param name `character` function name, possibly using namespace colon `::`, also -#' works with `:::` (sometimes needed, but strongly discouraged) -#' @param ... arguments to pass to function with name `name` +#' works with `:::` (sometimes needed, but strongly discouraged). +#' @param ... arguments to pass to function with name `name`. #' @param unlist_args `list` extra arguments passed in a single list, -#' avoids the use of `do.call` with this function +#' avoids the use of `do.call` with this function. +#' +#' @return `call`. +#' #' @examples +#' # use non-exported function from teal.transform +#' call_with_colon <- getFromNamespace("call_with_colon", "teal.transform") #' -#' print_call_and_eval <- function(x) { -#' eval(print(x)) -#' } +#' print_call_and_eval <- function(x) eval(print(x)) #' #' print_call_and_eval( -#' teal.transform:::call_with_colon("glue::glue", "x = {x}", x = 10) +#' call_with_colon("glue::glue", "x = {x}", x = 10) #' ) -#' \dontrun{ +#' #' # mtcars$cyl evaluated #' print_call_and_eval( -#' teal.transform:::call_with_colon("dplyr::filter", as.name("mtcars"), mtcars$cyl == 6) +#' call_with_colon("dplyr::filter", as.name("mtcars"), mtcars$cyl == 6) #' ) #' #' # mtcars$cyl argument not evaluated immediately (in call expression) #' print_call_and_eval( -#' teal.transform:::call_with_colon("dplyr::filter", as.name("mtcars"), quote(cyl == 6)) +#' call_with_colon("dplyr::filter", as.name("mtcars"), quote(cyl == 6)) #' ) #' #' # does not work because argument is evaluated and the @@ -414,14 +447,14 @@ call_extract_list <- function(dataname, varname, dollar = TRUE) { #' #' nb_args <- function(...) nargs() #' print_call_and_eval( -#' teal.transform:::call_with_colon("nb_args", arg1 = 1, unlist_args = list(arg2 = 2, args3 = 3)) +#' call_with_colon("nb_args", arg1 = 1, unlist_args = list(arg2 = 2, args3 = 3)) #' ) #' # duplicate arguments #' print_call_and_eval( -#' teal.transform:::call_with_colon("nb_args", arg1 = 1, unlist_args = list(arg2 = 2, args2 = 2)) +#' call_with_colon("nb_args", arg1 = 1, unlist_args = list(arg2 = 2, args2 = 2)) #' ) -#' } #' @keywords internal +#' call_with_colon <- function(name, ..., unlist_args = list()) { checkmate::assert_string(name) checkmate::assert_list(unlist_args) @@ -434,27 +467,30 @@ call_with_colon <- function(name, ..., unlist_args = list()) { #' Combine calls by operator #' -#' Combine list of calls by specific operator +#' Combine list of calls by specific operator. #' -#' @param operator (`character(1)` or `name`)\cr -#' name/symbol of the operator. +#' @param operator (`character(1)` or `name`) name / symbol of the operator. +#' @param calls (`list` of calls) list containing calls to be combined by `operator`. #' -#' @param calls (`list` of calls)\cr -#' list containing calls to be combined by `operator` +#' @return A combined `call`. #' -#' @return call #' @examples -#' teal.transform:::calls_combine_by( +#' # use non-exported function from teal.transform +#' calls_combine_by <- getFromNamespace("calls_combine_by", "teal.transform") +#' call_condition_choice <- getFromNamespace("call_condition_choice", "teal.transform") +#' call_condition_range <- getFromNamespace("call_condition_range", "teal.transform") +#' +#' calls_combine_by( #' "&", #' calls = list( -#' teal.transform:::call_condition_choice("SEX", "F"), -#' teal.transform:::call_condition_range("AGE", c(20, 50)), -#' teal.transform:::call_condition_choice("ARM", "ARM: A"), +#' call_condition_choice("SEX", "F"), +#' call_condition_range("AGE", c(20, 50)), +#' call_condition_choice("ARM", "ARM: A"), #' TRUE #' ) #' ) -#' @return a combined `call` #' @keywords internal +#' calls_combine_by <- function(operator, calls) { checkmate::assert_string(operator) stopifnot( diff --git a/R/check_selector.R b/R/check_selector.R index 53de6540..122f5f4e 100644 --- a/R/check_selector.R +++ b/R/check_selector.R @@ -1,21 +1,24 @@ #' Check selector `dataname` element #' -#' @param dataname selector element +#' @param dataname (`character(1)`) selector element. #' -#' @return error or nothing +#' @return Raises an error when check fails, otherwise, it returns the `dataname` +#' parameter, invisibly and unchanged. +#' +#' @keywords internal #' -#' @noRd check_selector_dataname <- function(dataname) { checkmate::assert_string(dataname) } #' Check selector filters element #' -#' @param filters selector element generated by `data_extract_srv` +#' @param filters (`list`) selector element generated by `data_extract_srv`. +#' +#' @return Raises an error when the check fails, otherwise it returns `NULL`, invisibly. #' -#' @return error or nothing +#' @keywords internal #' -#' @noRd check_selector_filters <- function(filters) { check_selector_filter <- function(x) { is.list(x) && @@ -32,55 +35,65 @@ check_selector_filters <- function(filters) { #' Check selector select element #' -#' @param select selector element generated by `data_extract_srv` +#' @param select (`character`) selector element generated by `data_extract_srv`. #' -#' @return error or nothing +#' @return Raises an error when check fails, otherwise, it returns the `select` +#' parameter, invisibly and unchanged. +#' +#' @keywords internal #' -#' @noRd check_selector_select <- function(select) { checkmate::assert_character(select) } #' Check selector keys element #' -#' @param keys selector element generated by `data_extract_srv` +#' @param keys (`character`) selector element generated by `data_extract_srv`. +#' +#' @return Raises an error when check fails, otherwise, it returns the `keys` +#' parameter, invisibly and unchanged. #' -#' @return error or nothing +#' @keywords internal #' -#' @noRd check_selector_keys <- function(keys) { checkmate::assert_character(keys, min.len = 0L, any.missing = FALSE) } #' Check selector reshape element #' -#' @param reshape selector element generated by `data_extract_srv` +#' @param reshape (`logical(1)`) selector element generated by `data_extract_srv`. #' -#' @return error or nothing +#' @return Raises an error when check fails, otherwise, it returns the `reshape` +#' parameter, invisibly and unchanged. +#' +#' @keywords internal #' -#' @noRd check_selector_reshape <- function(reshape) { checkmate::assert_flag(reshape) } #' Check selector internal_id element #' -#' @param internal_id selector element generated by `data_extract_srv` +#' @param internal_id (`character(1)`) selector element generated by `data_extract_srv`. +#' +#' @return Raises an error when check fails, otherwise, it returns the `internal_id` +#' parameter, invisibly and unchanged. #' -#' @return error or nothing +#' @keywords internal #' -#' @noRd check_selector_internal_id <- function(internal_id) { checkmate::assert_string(internal_id) } #' Check selector #' -#' @param selector (`list`) of selector elements generated by `data_extract_srv` +#' @param selector (`list`) of selector elements generated by `data_extract_srv`. +#' +#' @return Raises an error when check fails, otherwise, it returns the `selector` +#' parameter, invisibly and unchanged. #' -#' @return error or nothing +#' @keywords internal #' -#' @noRd check_selector <- function(selector) { # An error from the checks below is transformed to a shiny::validate error # so shiny can display it in grey not in red in an application @@ -100,4 +113,5 @@ check_selector <- function(selector) { }, error = function(e) shiny::validate(e$message) ) + invisible(selector) } diff --git a/R/choices_labeled.R b/R/choices_labeled.R index bf44ddaa..066e0347 100644 --- a/R/choices_labeled.R +++ b/R/choices_labeled.R @@ -1,59 +1,68 @@ -#' Set "`: