209 use ospsuite utils

DESCRIPTION

@@ -26,7 +26,8 @@ Imports:
     ggplot2 (>= 3.3.0),
     R6,
     reshape2,
-    jsonlite
+    jsonlite,
+    ospsuite.utils
 Depends: 
     R (>= 3.5)
 Encoding: UTF-8
@@ -40,7 +41,6 @@ Suggests:
 VignetteBuilder: knitr
 Collate: 
     'aaa-utilities.R'
-    'enum.R'
     'aggregation-input.R'
     'aggregation-summary.R'
     'atom-plots.R'

NAMESPACE

@@ -36,6 +36,7 @@ export(BackgroundConfiguration)
 export(BackgroundElement)
 export(BoxWhiskerDataMapping)
 export(BoxWhiskerPlotConfiguration)
+export(CaptionProperties)
 export(ColorMaps)
 export(DDIComparisonTypes)
 export(DDIRatioDataMapping)
@@ -153,4 +154,5 @@ export(useTemplateTheme)
 export(useTheme)
 import(ggplot2)
 import(jsonlite)
+import(ospsuite.utils)
 import(utils)

R/aggregation-input.R

@@ -39,7 +39,7 @@ predefinedPercentiles <- c(0, 1, 2.5, 5, 10, 15, 20, 25, 50, 75, 80, 85, 90, 95,
 #' @description
 #' Bank of predefined functions ready to use by Aggregation methods. Bank defined as Enum.
 #' To access the function from its name, use match.fun: e.g. testFun <- match.fun("mean-1.96sd")
-#' @include enum.R
+#' @import ospsuite.utils
 #' @export
 #' @family enum helpers
 tlfStatFunctions <- enum(c(

R/atom-plots.R

@@ -14,6 +14,7 @@
 #' 
 #' @family atom plots
 #' @export
+#' @import ospsuite.utils
 #' @examples
 #' # Initialize an empty plot
 #' p <- initializePlot()
@@ -121,7 +122,7 @@ addScatter <- function(data = NULL,
   if (isOfLength(data, 0)) {
     validateIsSameLength(x, y)
     data <- as.data.frame(cbind(x = x, y = y))
-    dataMapping <- dataMapping %||% XYGDataMapping$new(x = ifnotnull(x, "x"), y = ifnotnull(y, "y"), data = data)
+    dataMapping <- dataMapping %||% XYGDataMapping$new(x = ifNotNull(x, "x"), y = ifNotNull(y, "y"), data = data)
   }
   # Enforce data to be a data.frame for dataMapping
   if (!isOfType(data, "data.frame")) {
@@ -250,7 +251,7 @@ addLine <- function(data = NULL,
   if (isOfLength(data, 0)) {
     data <- as.data.frame(cbind(x = x, y = y))
 
-    dataMapping <- dataMapping %||% XYGDataMapping$new(x = ifnotnull(x, "x"), y = ifnotnull(y, "y"), data = data)
+    dataMapping <- dataMapping %||% XYGDataMapping$new(x = ifNotNull(x, "x"), y = ifNotNull(y, "y"), data = data)
   }
 
   # Enforce data to be a data.frame for dataMapping

R/boxwhisker-get-measure.R

@@ -32,7 +32,7 @@ getBoxWhiskerMeasure <- function(data,
 
   # Redfine group and y while removing NA values
   y <- data[!is.na.data.frame(data[, dataMapping$y]), dataMapping$y]
-  group <- ifnotnull(
+  group <- ifNotNull(
     dataMapping$x,
     data[!is.na.data.frame(data[, dataMapping$y]), dataMapping$x],
     as.factor(rep("", length(y)))

R/datamapping-range.R

@@ -80,7 +80,7 @@ RangeDataMapping <- R6::R6Class(
           self$data[, grouping$label] <- grouping$getCaptions(data, metaData)
           # Dummy variable for default aesthetics
           # Will be used to define legend labels
-          self$data$legendLabels <- ifnotnull(
+          self$data$legendLabels <- ifNotNull(
             self$data$legendLabels,
             paste(self$data$legendLabels, grouping$getCaptions(data, metaData), sep = "-"),
             grouping$getCaptions(data, metaData)

R/error-checks.R

@@ -1,148 +1,3 @@
-#' @keywords internal
-isSameLength <- function(...) {
-  args <- list(...)
-  nrOfLengths <- length(unique(lengths(args)))
-
-  return(nrOfLengths == 1)
-}
-
-#' Check if the provided object has nbElements elements
-#'
-#' @param object An object or a list of objects
-#' @param nbElements number of elements that are supposed in object
-#'
-#' @return TRUE if the object or all objects inside the list have nbElements.
-#' Only the first level of the given list is considered.
-#' @keywords internal
-isOfLength <- function(object, nbElements) {
-  return(length(object) == nbElements)
-}
-
-#' @keywords internal
-validateIsOfLength <- function(object, nbElements) {
-  if (isOfLength(object, nbElements)) {
-    return()
-  }
-  stop(messages$errorWrongLength(object, nbElements))
-}
-
-#' Check if the provided object is of certain type
-#'
-#' @param object An object or a list of objects
-#' @param type String  representation or Class of the type that should be checked for
-#'
-#' @return TRUE if the object or all objects inside the list are of the given type.
-#' Only the first level of the given list is considered.
-#' @keywords internal
-isOfType <- function(object, type) {
-  if (is.null(object)) {
-    return(FALSE)
-  }
-
-  type <- typeNamesFrom(type)
-
-  inheritType <- function(x) inherits(x, type)
-
-  if (inheritType(object)) {
-    return(TRUE)
-  }
-  object <- c(object)
-
-  all(sapply(object, inheritType))
-}
-
-#' @keywords internal
-validateIsOfType <- function(object, type, nullAllowed = FALSE) {
-  if (nullAllowed && is.null(object)) {
-    return()
-  }
-
-  if (isOfType(object, type)) {
-    return()
-  }
-  # Name of the variable in the calling function
-  objectName <- deparse(substitute(object))
-  objectTypes <- typeNamesFrom(type)
-
-  stop(messages$errorWrongType(objectName, class(object)[1], objectTypes))
-}
-
-#' @keywords internal
-validateEnumValue <- function(enum, value) {
-  if (value %in% names(enum)) {
-    return()
-  }
-
-  stop(messages$errorValueNotInEnum(enum, value))
-}
-
-#' @keywords internal
-typeNamesFrom <- function(type) {
-  if (is.character(type)) {
-    return(type)
-  }
-  type <- c(type)
-  sapply(type, function(t) t$classname)
-}
-
-#' @keywords internal
-validateIsString <- function(object, nullAllowed = FALSE) {
-  validateIsOfType(object, "character", nullAllowed)
-}
-
-#' @keywords internal
-validateIsNumeric <- function(object, nullAllowed = FALSE) {
-  validateIsOfType(object, c("numeric", "integer"), nullAllowed)
-}
-
-#' @keywords internal
-validateIsLogical <- function(object, nullAllowed = FALSE) {
-  validateIsOfType(object, "logical", nullAllowed)
-}
-
-#' @keywords internal
-validateIsSameLength <- function(...) {
-  if (isSameLength(...)) {
-    return()
-  }
-  # Name of the variable in the calling function
-  objectName <- deparse(substitute(list(...)))
-
-  # Name of the arguments
-  argnames <- sys.call()
-  arguments <- paste(lapply(argnames[-1], as.character), collapse = ", ")
-
-  stop(messages$errorDifferentLength(arguments))
-}
-
-#' Check if the provided object is included in a parent object
-#'
-#' @param values Vector of values
-#' @param parentValues Vector of values
-#'
-#' @return TRUE if the values are inside the parent values.
-#' @keywords internal
-isIncluded <- function(values, parentValues) {
-  if (is.null(values)) {
-    return(FALSE)
-  }
-
-  return(as.logical(min(values %in% parentValues)))
-}
-
-#' @keywords internal
-validateIsIncluded <- function(values, parentValues, nullAllowed = FALSE) {
-  if (nullAllowed && is.null(values)) {
-    return()
-  }
-
-  if (isIncluded(values, parentValues)) {
-    return()
-  }
-
-  stop(messages$errorNotIncluded(values, parentValues))
-}
-
 #' @keywords internal
 validateMapping <- function(mapping, data, nullAllowed = FALSE) {
   if (nullAllowed && is.null(mapping)) {

R/messages.R

@@ -1,41 +1,4 @@
 messages <- list(
-  errorWrongType = function(objectName, type, expectedType, optionalMessage = NULL) {
-    # Name of the calling function
-    callingFunctions <- sys.calls()
-    callingFunction <- sys.call(-length(callingFunctions) + 1)[[1]]
-
-    expectedTypeMsg <- paste0(expectedType, collapse = ", or ")
-
-    paste0(
-      callingFunction, ": argument '", objectName,
-      "' is of type '", type, "', but expected '", expectedTypeMsg, "'!", optionalMessage
-    )
-  },
-  errorDifferentLength = function(objectNames, optionalMessage = NULL) {
-    # Name of the calling function
-    callingFunctions <- sys.calls()
-    callingFunction <- sys.call(-length(callingFunctions) + 1)[[1]]
-
-    paste0(
-      callingFunction, ": Arguments '", objectNames,
-      "' must have the same length, but they don't!", optionalMessage
-    )
-  },
-  errorWrongLength = function(object, nbElements, optionalMessage = NULL) {
-    # Name of the calling function
-    callingFunctions <- sys.calls()
-    callingFunction <- sys.call(-length(callingFunctions) + 1)[[1]]
-    paste0(
-      callingFunction, ": Object should be of length '", nbElements, "', but is of length '", length(object), "' instead. ", optionalMessage
-    )
-  },
-  errorEnumNotAllNames = "The enumValues has some but not all names assigned. They must be all assigned or none assigned",
-  errorValueNotInEnum = function(enum, value) {
-    paste0("Value '", value, "' is not in defined enumeration values: '", paste0(names(enum), collapse = ", "), "'.")
-  },
-  errorNotIncluded = function(values, parentValues) {
-    paste0("Values '", paste0(values, collapse = ", "), "' are not in included in parent values: '", paste0(parentValues, collapse = ", "), "'.")
-  },
   errorExceedLength = function(values, parentLengths) {
     paste0("Values '", paste0(values, collapse = ", "), "' exceed variable length : '", paste0(parentLengths, collapse = ", "), "'.")
   },

R/observed-data-mapping.R

@@ -53,8 +53,8 @@ ObservedDataMapping <- R6::R6Class(
       # If not, error/uncertainty are used and 
       # creates ymin and ymax as y +/- error
       self$error <- error %||% uncertainty
-      self$ymin <- ymin %||% ifnotnull(self$error, "ymin")
-      self$ymax <- ymax %||% ifnotnull(self$error, "ymax")
+      self$ymin <- ymin %||% ifNotNull(self$error, "ymin")
+      self$ymax <- ymax %||% ifNotNull(self$error, "ymax")
       self$mdv <- mdv
     },
 

R/plot-histogram.R

@@ -53,7 +53,7 @@ plotHistogram <- function(data = NULL,
     validateIsNumeric(x)
     data <- data.frame(x = x)
     dataMapping <- dataMapping %||% HistogramDataMapping$new(
-      x = ifnotnull(x, "x"),
+      x = ifNotNull(x, "x"),
       data = data
     )
   }

R/plot-tornado.R

@@ -48,8 +48,8 @@ plotTornado <- function(data = NULL,
 
     dataMapping <- dataMapping %||% TornadoDataMapping$new(
       sorted = sorted,
-      x = ifnotnull(x, "x"),
-      y = ifnotnull(y, "y"),
+      x = ifNotNull(x, "x"),
+      y = ifNotNull(y, "y"),
       data = data
     )
   }

R/tlf-env.R

@@ -6,7 +6,7 @@ tlfEnv <- new.env(parent = emptyenv())
 tlfEnv$packageName <- "tlf"
 
 #' @title LegendPositions
-#' @include enum.R
+#' @import ospsuite.utils
 #' @export
 #' @description
 #' List of all available legend positions

R/tornado-datamapping.R

@@ -34,12 +34,12 @@ TornadoDataMapping <- R6::R6Class(
       self$groupMapping$color$label <- self$groupMapping$color$label %||% y
       self$groupMapping$color$group <- self$groupMapping$color$group %||% y
       # Link fill/shape to color if they are not explicitely mapped
-      self$groupMapping$fill <- ifnotnull(
+      self$groupMapping$fill <- ifNotNull(
         self$groupMapping$fill$label,
         self$groupMapping$fill,
         self$groupMapping$color
       )
-      self$groupMapping$shape <- ifnotnull(
+      self$groupMapping$shape <- ifNotNull(
         self$groupMapping$shape$label,
         self$groupMapping$shape,
         self$groupMapping$color

R/utilities-aesthetics.R

@@ -1,6 +1,7 @@
 #' @title AestheticProperties
 #' @description Enum of aesthetic property names of `ggplot2`
 #' @export
+#' @import ospsuite.utils
 #' @family enum helpers
 AestheticProperties <- enum(c(
   "color",
@@ -14,6 +15,7 @@ AestheticProperties <- enum(c(
 #' @title Linetypes
 #' @description Enum of `ggplot2` linetypes
 #' @export
+#' @import ospsuite.utils
 #' @family enum helpers
 Linetypes <- enum(c(
   "solid",
@@ -28,6 +30,7 @@ Linetypes <- enum(c(
 #' @title Shapes
 #' @description List of some `ggplot2` shapes
 #' @export
+#' @import ospsuite.utils
 #' @family enum helpers
 Shapes <- list(
   "circle" = "circle",
@@ -95,6 +98,7 @@ ColorMaps <- list(
 
 #' @title AestheticSelectionKeys
 #' @description List of some `ggplot2` shapes
+#' @import ospsuite.utils
 #' @export
 AestheticSelectionKeys <- enum(c(
   "next",