Merge pull request #124 from Open-Systems-Pharmacology/develop

V1.4

.github/workflows/check-full.yaml

@@ -6,9 +6,9 @@
 # usethis::use_github_action("check-standard") will install it.
 on:
   push:
-    branches: [main, master, develop]
+    branches: [main, develop]
   pull_request:
-    branches: [main, master, develop]
+    branches: [main, develop]
 
 name: R-CMD-check
 
@@ -27,13 +27,13 @@ jobs:
           - {os: macOS-latest,   r: 'oldrel-1'}
           #- {os: macOS-latest,   r: 'oldrel-2'}
 
-          - {os: windows-latest, r: 'devel'}
+#          - {os: windows-latest, r: 'devel'}
           - {os: windows-latest, r: 'release'}
           - {os: windows-latest, r: 'oldrel-1'}
           - {os: windows-latest, r: 'oldrel-2'}
 
           # Use older ubuntu to maximise backward compatibility
-          - {os: ubuntu-18.04,   r: 'devel', http-user-agent: 'release'}
+#          - {os: ubuntu-18.04,   r: 'devel', http-user-agent: 'release'}
           - {os: ubuntu-18.04,   r: 'release'}
           - {os: ubuntu-18.04,   r: 'oldrel-1'}
           - {os: ubuntu-18.04,   r: 'oldrel-2'}

.github/workflows/pkgdown.yaml

@@ -2,9 +2,9 @@
 # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help
 on:
   push:
-    branches: [main, master, develop]
+    branches: [main, develop]
   pull_request:
-    branches: [main, master, develop]
+    branches: [main, develop]
   release:
     types: [published]
   workflow_dispatch:

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: ospsuite.utils
 Title: Utility Functions for Open Systems Pharmacology R Packages
-Version: 1.3.0
+Version: 1.4.0
 Authors@R: c(
     person("Open-Systems-Pharmacology Community", role = c("cph", "fnd")),
     person("Michael", "Sevestre", , "michael@design2code.ca", role = c("aut", "cre")),
@@ -22,7 +22,8 @@ BugReports:
     https://github.com/open-systems-pharmacology/OSPSuite.RUtils/issues
 Depends: 
     R (>= 3.6)
-Imports: 
+Imports:
+    purrr,
     R6
 Suggests: 
     knitr,
@@ -32,7 +33,7 @@ Config/testthat/edition: 3
 Encoding: UTF-8
 Language: en-US
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.1.2
+RoxygenNote: 7.2.3
 Collate: 
     'enum.R'
     'formatNumerics.R'
@@ -41,6 +42,7 @@ Collate:
     'utilities.R'
     'ospsuite.utils-env.R'
     'printable.R'
+    'utilities-conditional.R'
     'utilities-validation.R'
     'validation-emptiness.R'
     'validation-enum.R'

NAMESPACE

@@ -10,11 +10,14 @@ export(enumKeys)
 export(enumPut)
 export(enumRemove)
 export(enumValues)
+export(flattenList)
 export(formatNumerics)
 export(getEnumKey)
 export(getOSPSuiteUtilsSetting)
 export(hasEmptyStrings)
 export(hasOnlyDistinctValues)
+export(ifEqual)
+export(ifIncluded)
 export(ifNotNull)
 export(isEmpty)
 export(isFileExtension)
@@ -26,6 +29,7 @@ export(messages)
 export(objectCount)
 export(ospsuiteUtilsSettingNames)
 export(toList)
+export(toMissingOfType)
 export(validateEnumValue)
 export(validateHasOnlyDistinctValues)
 export(validateHasOnlyNonEmptyStrings)

NEWS.md

@@ -1,8 +1,20 @@
+# ospsuite.utils 1.4.0
+
+NEW FUNCTIONS
+
+* `ifEqual()` and `ifIncluded()` for conditional values.
+
+* `flattenList()` to flatten a list to an atomic vector of desired type.
+
+* `toMissingOfType()` to convert special constants (`NULL`, `Inf`, `NA`, etc.)
+  to `NA` of desired type.
+
 # ospsuite.utils 1.3.0
 
 NEW FUNCTIONS
 
-* `hasEmptyStrings()` and `validateHasOnlyNonEmptyStrings()` to check for empty strings.
+* `hasEmptyStrings()` and `validateHasOnlyNonEmptyStrings()` to check for empty
+  strings.
 
 * `objectCount` to count number of objects.
 
@@ -42,8 +54,8 @@ NEW FUNCTIONS
 * Adds `isEmpty()` and `validateIsNotEmpty()` functions to validate that objects
   aren't empty (#58; thanks to @pchelle).
 
-* Adds `getOSPSuiteUtilsSetting()` function to get global settings
-  (see enum `ospsuiteUtilsSettingNames` for supported settings).
+* Adds `getOSPSuiteUtilsSetting()` function to get global settings (see enum
+  `ospsuiteUtilsSettingNames` for supported settings).
 
 # ospsuite.utils 1.1.0
 
@@ -72,3 +84,4 @@ BUG FIXES
 # ospsuite.utils 1.0.0
 
 * Initial release.
+

R/messages.R

@@ -237,6 +237,9 @@ messages <- list(
   errorDuplicatedValues = function(optionalMessage = NULL) {
     paste("Object has duplicated values; only unique values are allowed.", optionalMessage)
   },
+  errorOnlyVectorAllowed = function() {
+    paste("Argument to parameter `x` can only be a vector.")
+  },
   errorPackageSettingNotFound = function(settingName, globalEnv) {
     paste0(
       "No global setting with the name '",

R/utilities-conditional.R

@@ -0,0 +1,84 @@
+#' @title Value conditional on equality
+#'
+#' @description
+#'
+#' Short-key checking if arguments 1 and 2 are equal,
+#' output argument 3 if equal, or output argument 4 otherwise.
+#'
+#' @param x argument 1
+#' @param y argument 2
+#' @param outputIfEqual argument 3
+#' @param outputIfNotEqual argument 4
+#'
+#' @examples
+#'
+#' ifEqual(1, 1, "x", "y") # "x"
+#' ifEqual(1, 2, "x", "y") # "y"
+#'
+#' @export
+ifEqual <- function(x, y, outputIfEqual, outputIfNotEqual = NULL) {
+  if (x == y) {
+    return(outputIfEqual)
+  }
+
+  return(outputIfNotEqual)
+}
+
+#' @title Value conditional on inclusion
+#'
+#' @description
+#'
+#' Shortkey checking if arguments 1 is included in 2,
+#' output argument 3 if included, or output argument 4 otherwise.
+#'
+#' @inheritParams ifEqual
+#' @param outputIfIncluded argument 3
+#' @param outputIfNotIncluded argument 4
+#'
+#' @examples
+#'
+#' ifIncluded("a", c("a", "b"), 1, 2) # 1
+#' ifIncluded("x", c("a", "b"), 1, 2) # 2
+
+#'
+#' @export
+ifIncluded <- function(x, y, outputIfIncluded, outputIfNotIncluded = NULL) {
+  if (isIncluded(x, y)) {
+    return(outputIfIncluded)
+  }
+
+  return(outputIfNotIncluded)
+}
+
+#' @title Value conditional on `NULL`
+#'
+#' @description
+#'
+#' Short-key checking if argument 1 is not `NULL`, output the argument 2 if not
+#' null, or output argument 3 otherwise.
+#'
+#' @param condition argument 1
+#' @param outputIfNotNull argument 2
+#' @param outputIfNull argument 3
+#'
+#' @return
+#' `outputIfNotNull` if condition is not `NULL`, `outputIfNull` otherwise.
+#'
+#' @description
+#' Check if condition is not `NULL`, if so output `outputIfNotNull`,
+#' otherwise, output `outputIfNull`.
+#'
+#' @examples
+#'
+#' ifNotNull(NULL, "x")
+#' ifNotNull(NULL, "x", "y")
+#' ifNotNull(1 < 2, "x", "y")
+#'
+#' @export
+ifNotNull <- function(condition, outputIfNotNull, outputIfNull = NULL) {
+  if (!is.null(condition)) {
+    return(outputIfNotNull)
+  }
+
+  return(outputIfNull)
+}

R/utilities.R

@@ -14,54 +14,100 @@
 #' NULL %||% 2
 #'
 #' @export
-`%||%` <- function(x, y) {
-  if (is.null(x)) y else x
-}
+`%||%` <- purrr::`%||%`
 
-#' Shortkey checking if argument 1 is not `NULL`, output the argument 2 if not
-#' null, or output argument 3 otherwise
+#' Make sure the object is a list
 #'
-#' @param condition argument 1
-#' @param outputIfNotNull argument 2
-#' @param outputIfNull argument 3
+#' @param object Object to be converted to a list.
 #'
 #' @return
-#' `outputIfNotNull` if condition is not `NULL`, `outputIfNull` otherwise.
+#' If `is.list(object) == TRUE`, returns the `object`; otherwise, `list(object)`.
 #'
-#' @description
-#' Check if condition is not `NULL`, if so output `outputIfNotNull`,
-#' otherwise, output `outputIfNull`.
+#' @examples
+#' toList(list("a" = 1, "b" = 2))
+#' toList(c("a" = 1, "b" = 2))
+#'
+#' @export
+toList <- function(object) {
+  if (is.list(object)) {
+    return(object)
+  }
+
+  return(list(object))
+}
+
+#' Flatten a list to an atomic vector of desired type
+#'
+#' @param x A list or an atomic vector. If the latter, no change will be made.
+#' @param type Type of atomic vector to be returned.
+#'
+#' @details
+#'
+#' The `type` argument will decide which variant from `purrr::flatten()` family
+#' is used to flatten the list.
 #'
 #' @examples
-#' ifNotNull(NULL, "x")
-#' ifNotNull(NULL, "x", "y")
-#' ifNotNull(1 < 2, "x", "y")
+#'
+#' flattenList(list(1, 2, 3, NA), type = "numeric")
+#' flattenList(list(TRUE, FALSE, NA), type = "integer")
+#'
+#' @return An atomic vector of desired type.
 #'
 #' @export
-ifNotNull <- function(condition, outputIfNotNull, outputIfNull = NULL) {
-  if (!is.null(condition)) {
-    return(outputIfNotNull)
+flattenList <- function(x, type) {
+  if (!is.null(dim(x))) {
+    stop(messages$errorOnlyVectorAllowed())
+  }
+
+  if (is.list(x)) {
+    x <- switch(type,
+      "character" = purrr::flatten_chr(x),
+      "numeric" = ,
+      "real" = ,
+      "double" = purrr::flatten_dbl(x),
+      "integer" = purrr::flatten_int(x),
+      "logical" = purrr::flatten_lgl(x),
+      purrr::flatten(x)
+    )
   }
 
-  return(outputIfNull)
+  return(x)
 }
 
-#' Make sure the object is a list
+
+#' Convert special constants to `NA` of desired type
 #'
-#' @param object Object to be converted to a list.
+#' @details
 #'
-#' @return
-#' If `is.list(object) == TRUE`, returns the `object`; otherwise, `list(object)`.
+#' Special constants (`NULL`, `Inf`, `-Inf`, `NaN`,  `NA`) will be converted to
+#' `NA` of desired type.
+#'
+#' This function is **not** vectorized, and therefore only scalar values should
+#' be entered.
+#'
+#' @param x A single element.
+#' @inheritParams flattenList
 #'
 #' @examples
-#' toList(list("a" = 1, "b" = 2))
-#' toList(c("a" = 1, "b" = 2))
+#'
+#' toMissingOfType(NA, type = "real")
+#' toMissingOfType(NULL, type = "integer")
 #'
 #' @export
-toList <- function(object) {
-  if (is.list(object)) {
-    return(object)
+toMissingOfType <- function(x, type) {
+  # all unexpected values will be converted to `NA` of a desired type
+  if (is.null(x) || is.na(x) || is.nan(x) || is.infinite(x)) {
+    x <- switch(type,
+      "character" = NA_character_,
+      "numeric" = ,
+      "real" = ,
+      "double" = NA_real_,
+      "integer" = NA_integer_,
+      "complex" = NA_complex_,
+      "logical" = NA,
+      stop("Incorrect type entered.")
+    )
   }
 
-  return(list(object))
+  return(x)
 }

R/validation-type.R

@@ -81,7 +81,7 @@ validateIsOfType <- function(object, type, nullAllowed = FALSE) {
   callStack <- as.character(sys.call(-1)[[1]])
 
   # Object name is one frame further for functions such as ValidateIsNumeric
-  if ((length(callStack) > 0) && grepl(pattern = "validateIs", x = callStack)) {
+  if ((length(callStack) > 0) && any(grepl(pattern = "validateIs", x = callStack))) {
     objectName <- deparse(substitute(object, sys.frame(-1)))
   }