From ab9794507959188487347c42a9ce36a5e47f70ab Mon Sep 17 00:00:00 2001 From: Indrajeet Patil Date: Thu, 10 Feb 2022 13:05:58 +0100 Subject: [PATCH] 1.1.0 release (#57) * Create develop branch * closes #29 (#44) - better documentation for `isIncluded()` - more tests - more examples * closes #29 (#45) * closes #29 * if not a vector, convert to one * closes #29 (#46) * closes #29 error if objects are entered as arguments * drop purrr * don't accept environments either (#47) just for good measure * Fixes #32 set a more consistent behaviour for formatNumerics (#48) * closes #30 (#49) * closes #31 (#52) * closes #50 (#51) remove unnecessary lint detection * closes #34 (#54) Separates docs for `validateIsSameLength()` from `validateIsOfLength()` * closes #21; prepare for CRAN (#55) * closes #21; prepare for CRAN * more tests with list * use correct URL for codecov in README (#56) Co-authored-by: Michael Sevestre Co-authored-by: Pierre Chelle <45343665+pchelle@users.noreply.github.com> --- .Rbuildignore | 1 + .lintr | 2 +- DESCRIPTION | 2 +- NAMESPACE | 1 + NEWS.md | 14 +- R/error-checks.R | 363 ++++++++++-------- R/formatNumerics.R | 8 +- R/validation-helpers.R | 36 +- README.Rmd | 2 +- README.md | 2 +- cran-comments.md | 7 +- man/formatNumerics.Rd | 6 +- ...iqueValues.Rd => hasOnlyDistinctValues.Rd} | 13 +- man/isIncluded.Rd | 25 +- man/isSameLength.Rd | 13 +- man/validateIsIncluded.Rd | 5 +- man/validateIsOfLength.Rd | 22 +- man/validateIsSameLength.Rd | 25 ++ tests/testthat/test-error-checks.R | 30 +- tests/testthat/test-formatNumerics.R | 22 +- tests/testthat/test-validation-helpers.R | 35 +- 21 files changed, 392 insertions(+), 242 deletions(-) rename man/{hasUniqueValues.Rd => hasOnlyDistinctValues.Rd} (66%) create mode 100644 man/validateIsSameLength.Rd diff --git a/.Rbuildignore b/.Rbuildignore index b87eb2d..2be2a6d 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -54,3 +54,4 @@ references.bib ^rakefile\.rb ^postclean\.bat ^\.covrignore$ +^CRAN-SUBMISSION$ diff --git a/.lintr b/.lintr index 28ffd7f..b8c374c 100644 --- a/.lintr +++ b/.lintr @@ -1 +1 @@ -linters: with_defaults(object_name_linter = NULL, object_usage_linter = NULL, line_length_linter(120), cyclocomp_linter = cyclocomp_linter(20)) +linters: with_defaults(object_name_linter = NULL, object_usage_linter = NULL, line_length_linter(180), cyclocomp_linter = cyclocomp_linter(20), seq_linter = NULL) diff --git a/DESCRIPTION b/DESCRIPTION index d84b7d2..1972353 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Type: Package Package: ospsuite.utils Title: Utility Functions for Open Systems Pharmacology R Packages -Version: 1.0.0.9000 +Version: 1.1.0 Authors@R: c( person("Open-Systems-Pharmacology Community", role = c("cph", "fnd")), person("Michael", "Sevestre", , "michael@design2code.ca", role = "aut"), diff --git a/NAMESPACE b/NAMESPACE index 8d2acf2..898716b 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -12,6 +12,7 @@ export(enumRemove) export(enumValues) export(formatNumerics) export(getEnumKey) +export(hasOnlyDistinctValues) export(hasUniqueValues) export(ifNotNull) export(isFileExtension) diff --git a/NEWS.md b/NEWS.md index 7673aa5..a61216b 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,10 @@ -# ospsuite.utils 1.0.0.9000 +# ospsuite.utils 1.1.0 + +MAJOR CHANGES + +* `isIncluded()` now only accepts base types as valid inputs. + +* `formatNumerics()` now consistently returns output of type `"character"`. MINOR CHANGES @@ -8,6 +14,12 @@ MINOR CHANGES * `getEnumKey()` is added as an alias for `enumGetKey()` function. +* `hasOnlyDistinctValues()` is added as an alias for `hasUniqueValues()` function. + +BUG FIXES + +* `validateIsInteger()` now works with lists (#21). + # ospsuite.utils 1.0.0 * Initial release. diff --git a/R/error-checks.R b/R/error-checks.R index 56d3379..02be333 100644 --- a/R/error-checks.R +++ b/R/error-checks.R @@ -1,168 +1,195 @@ -# is or has helpers --------------------------------------------- - -#' Check if the provided object is of certain type -#' -#' @param object An object or an atomic vector or a list of objects. -#' @param type A single string or a vector of string representation or class of -#' the type that should be checked for. -#' @param nullAllowed Boolean flag if `NULL` is accepted for the `object`. If -#' `TRUE`, `NULL` always returns `TRUE`, otherwise `NULL` returns `FALSE`. -#' Default is `FALSE`. -#' -#' @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. -#' -#' @examples -#' # checking type of a single object -#' df <- data.frame(x = c(1, 2, 3)) -#' isOfType(df, "data.frame") -#' @export - -isOfType <- function(object, type, nullAllowed = FALSE) { - if (is.null(object)) { - return(nullAllowed) - } - - type <- .typeNamesFrom(type) - - inheritType <- function(x) { - if (is.null(x) && nullAllowed) { - return(TRUE) - } - inherits(x, type) - } - - if (inheritType(object)) { - return(TRUE) - } - - object <- c(object) - all(sapply(object, inheritType)) -} - -#' Check if input is included in a list -#' -#' @param values Vector of values -#' @param parentValues Vector of values -#' -#' @return `TRUE` if the values are inside the parent values. -#' @examples -#' A <- data.frame( -#' col1 = c(1, 2, 3), -#' col2 = c(4, 5, 6), -#' col3 = c(7, 8, 9) -#' ) -#' isIncluded("col3", names(A)) -#' @export -isIncluded <- function(values, parentValues) { - if (is.null(values)) { - return(FALSE) - } - - if (length(values) == 0) { - return(FALSE) - } - - return(as.logical(min(values %in% parentValues))) -} - -#' Check if two objects are of same length -#' @param ... Objects to compare. -#' -#' @examples -#' isSameLength(mtcars, ToothGrowth) -#' isSameLength(mtcars, mtcars) -#' @export - -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. -#' -#' @examples -#' df <- data.frame(x = c(1, 2, 3)) -#' isOfLength(df, 1) -#' isOfLength(df, 3) -#' @export - -isOfLength <- function(object, nbElements) { - return(length(object) == nbElements) -} - -#' Check if the provided path has required extension -#' -#' @param file file or path name to be checked -#' @param extension extension of the file required after "." -#' -#' @return `TRUE` if the path includes the extension. -#' -#' @examples -#' # TRUE -#' isFileExtension("enum.R", "R") -#' -#' # FALSE -#' isFileExtension("enum.R", "pkml") -#' @export - -isFileExtension <- function(file, extension) { - extension <- c(extension) - file_ext <- .fileExtension(file) - file_ext %in% extension -} - -#' Check that an array of values does not include any duplicate -#' -#' @param values An array of values -#' @param na.rm Logical to decide if missing values should be removed from the duplicate checking. -#' Note that duplicate `NA` values are flagged if `na.rm=FALSE`. -#' -#' @return Logical assessing if all values are unique -#' -#' @examples -#' hasUniqueValues(c("x", "y")) -#' hasUniqueValues(c("x", "y", "x")) -#' hasUniqueValues(c("x", NA, "y", NA), na.rm = FALSE) -#' hasUniqueValues(c("x", NA, "y", NA), na.rm = TRUE) -#' @export - -hasUniqueValues <- function(values, na.rm = TRUE) { - if (na.rm) { - values <- values[!is.na(values)] - } - - return(!any(duplicated(values))) -} - - -# utilities --------------------------------------------- - -#' @keywords internal - -.typeNamesFrom <- function(type) { - type <- c(type) - - sapply(type, function(t) { - if (is.character(t)) { - return(t) - } - - return(t$classname) - }) -} - -#' @keywords internal - -.fileExtension <- function(file) { - ex <- strsplit(basename(file), split = "\\.")[[1]] - return(utils::tail(ex, 1)) -} +# is or has helpers --------------------------------------------- + +#' Check if the provided object is of certain type +#' +#' @param object An object or an atomic vector or a list of objects. +#' @param type A single string or a vector of string representation or class of +#' the type that should be checked for. +#' @param nullAllowed Boolean flag if `NULL` is accepted for the `object`. If +#' `TRUE`, `NULL` always returns `TRUE`, otherwise `NULL` returns `FALSE`. +#' Default is `FALSE`. +#' +#' @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. +#' +#' @examples +#' # checking type of a single object +#' df <- data.frame(x = c(1, 2, 3)) +#' isOfType(df, "data.frame") +#' @export + +isOfType <- function(object, type, nullAllowed = FALSE) { + if (is.null(object)) { + return(nullAllowed) + } + + type <- .typeNamesFrom(type) + + inheritType <- function(x) { + if (is.null(x) && nullAllowed) { + return(TRUE) + } + inherits(x, type) + } + + if (inheritType(object)) { + return(TRUE) + } + + object <- c(object) + all(sapply(object, inheritType)) +} + +#' Check if a vector of values is included in another vector of values +#' +#' @param values A vector of values. +#' @param parentValues A vector of values where `values` are checked for +#' inclusion. +#' +#' @return +#' +#' Returns `TRUE` if the value or **all** `values` (if it's a vector) are +#' present in the `parentValues`; `FALSE` otherwise. +#' +#' @examples +#' # check if a column is present in dataframe +#' A <- data.frame( +#' col1 = c(1, 2, 3), +#' col2 = c(4, 5, 6), +#' col3 = c(7, 8, 9) +#' ) +#' isIncluded("col3", names(A)) # TRUE +#' +#' # check if single element is present in a vector (atomic or non-atomic) +#' isIncluded("x", list("w", "x", 1, 2)) # TRUE +#' isIncluded("x", c("w", "a", "y")) # FALSE +#' +#' # check if **all** values (if it's a vector) are contained in parent values +#' isIncluded(c("x", "y"), c("a", "y", "b", "x")) # TRUE +#' isIncluded(list("x", 1), list("a", "b", "x", 1)) # TRUE +#' isIncluded(c("x", "y"), c("a", "b", "x")) # FALSE +#' isIncluded(list("x", 1), list("a", "b", "x")) # FALSE +#' @export +isIncluded <- function(values, parentValues) { + values <- c(values) + + hasObject <- any(mapply(function(x) { + is.object(x) | is.environment(x) + }, values)) + + if (hasObject) { + stop("Only vectors of base object types are allowed.", call. = FALSE) + } + + if (is.null(values) || length(values) == 0) { + return(FALSE) + } + + as.logical(min(values %in% parentValues)) +} + +#' Check if objects are of same length +#' @param ... Objects to compare. +#' +#' @examples +#' # compare length of only 2 objects +#' isSameLength(mtcars, ToothGrowth) # FALSE +#' isSameLength(cars, BOD) # TRUE +#' +#' # or more number of objects +#' isSameLength(c(1, 2), c(TRUE, FALSE), c("x", "y")) # TRUE +#' isSameLength(list(1, 2), list(TRUE, FALSE), list("x")) # FALSE +#' @export + +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. +#' +#' @examples +#' df <- data.frame(x = c(1, 2, 3)) +#' isOfLength(df, 1) +#' isOfLength(df, 3) +#' @export + +isOfLength <- function(object, nbElements) { + return(length(object) == nbElements) +} + +#' Check if the provided path has required extension +#' +#' @param file file or path name to be checked +#' @param extension extension of the file required after "." +#' +#' @return `TRUE` if the path includes the extension. +#' +#' @examples +#' # TRUE +#' isFileExtension("enum.R", "R") +#' +#' # FALSE +#' isFileExtension("enum.R", "pkml") +#' @export + +isFileExtension <- function(file, extension) { + extension <- c(extension) + file_ext <- .fileExtension(file) + file_ext %in% extension +} + +#' Check that an array of values does not include any duplicate +#' +#' @param values An array of values +#' @param na.rm Logical to decide if missing values should be removed from the duplicate checking. +#' Note that duplicate `NA` values are flagged if `na.rm=FALSE`. +#' +#' @return Logical assessing if all values are unique +#' +#' @examples +#' hasOnlyDistinctValues(c("x", "y")) +#' hasOnlyDistinctValues(c("x", "y", "x")) +#' hasOnlyDistinctValues(c("x", NA, "y", NA), na.rm = FALSE) +#' hasOnlyDistinctValues(c("x", NA, "y", NA), na.rm = TRUE) +#' @export + +hasOnlyDistinctValues <- function(values, na.rm = TRUE) { + if (na.rm) { + values <- values[!is.na(values)] + } + + return(!any(duplicated(values))) +} + +#' @rdname hasOnlyDistinctValues +#' @export + +hasUniqueValues <- hasOnlyDistinctValues + +#' @keywords internal +.typeNamesFrom <- function(type) { + type <- c(type) + + sapply(type, function(t) { + if (is.character(t)) { + return(t) + } + + return(t$classname) + }) +} + +#' @keywords internal +.fileExtension <- function(file) { + ex <- strsplit(basename(file), split = "\\.")[[1]] + return(utils::tail(ex, 1)) +} diff --git a/R/formatNumerics.R b/R/formatNumerics.R index 8ad17b6..c0d7f1f 100644 --- a/R/formatNumerics.R +++ b/R/formatNumerics.R @@ -1,14 +1,14 @@ #' @title formatNumerics -#' @description Render numeric values of an `object` using the specified format: +#' @description Render numeric values of an `object` as character using the specified format: #' - If `object` is a data.frame or a list, `formatNumerics` applies on each of its fields -#' - If `object` is of type character or integer, `formatNumerics` leaves the values as is +#' - If `object` is of type character or integer, `formatNumerics` renders the values as is #' - If `object` is of type numeric, `formatNumerics` applies the defined format #' #' @param object An R object such as a list, a data.frame, character or numeric values. #' @param digits Number of decimal digits to render #' @param scientific Logical value defining if scientific writing is rendered #' -#' @return Numeric values are rendered as character values. If `object` was a +#' @return Numeric values are rendered as character values. If `object` is a #' data.frame or a list, a data.frame or list is returned with numeric values #' rendered as character values. #' @@ -26,7 +26,7 @@ formatNumerics <- function(object, digits = 2, scientific = FALSE) { # Return integer as is before they are assumed as numeric if (is.integer(object)) { - return(object) + return(as.character(object)) } # Method for numeric values diff --git a/R/validation-helpers.R b/R/validation-helpers.R index 518c6e5..8ca5f69 100644 --- a/R/validation-helpers.R +++ b/R/validation-helpers.R @@ -85,6 +85,10 @@ validateIsInteger <- function(object, nullAllowed = FALSE) { return() } + if (is.list(object)) { + object <- unlist(object) + } + # if it's an actual integer (e.g. 5L) if (is.integer(object)) { return() @@ -221,21 +225,15 @@ validateEnumValue <- function(value, enum, nullAllowed = FALSE) { #' @inheritParams isOfLength #' #' @return -#' -#' If validations are successful, `NULL` is returned. Otherwise, the functions -#' will error. +#' If validations are successful, `NULL` is returned. Otherwise, error is +#' signaled. #' #' @examples -#' A <- data.frame( -#' col1 = c(1, 2, 3), -#' col2 = c(4, 5, 6), -#' col3 = c(7, 8, 9) -#' ) -#' validateIsSameLength(A, A) -#' -#' # returns NULL if of two objects are of same length -#' validateIsSameLength(list(1, 2), c(3, 4)) +#' # returns `NULL` if of objects are of specified length +#' validateIsOfLength(list(1, 2), 2L) #' +#' # error otherwise +#' # validateIsOfLength(c("3", "4"), 3L) #' @export validateIsOfLength <- function(object, nbElements) { @@ -247,8 +245,18 @@ validateIsOfLength <- function(object, nbElements) { } -#' @rdname validateIsOfLength -#' @param ... Name of the variable in the calling function +#' Check if all objects are of same length +#' +#' @inheritParams isSameLength +#' +#' @inherit validateIsOfLength return return +#' +#' @examples +#' # returns `NULL` if of objects are of same length +#' validateIsSameLength(list(1, 2), c("3", "4")) +#' +#' # error otherwise +#' # validateIsSameLength(list(1, 2), c("3", "4"), c(FALSE)) #' @export validateIsSameLength <- function(...) { diff --git a/README.Rmd b/README.Rmd index 05c05f5..582e0f1 100644 --- a/README.Rmd +++ b/README.Rmd @@ -19,7 +19,7 @@ knitr::opts_chunk$set( [![R build status](https://github.com/Open-Systems-Pharmacology/OSPSuite.RUtils/workflows/R-CMD-check/badge.svg)](https://github.com/Open-Systems-Pharmacology/OSPSuite.RUtils) [![pkgdown](https://github.com/Open-Systems-Pharmacology/OSPSuite.RUtils/workflows/pkgdown/badge.svg)](https://github.com/Open-Systems-Pharmacology/OSPSuite.RUtils/actions) -[![codecov](https://codecov.io/gh/Open-Systems-Pharmacology/OSPSuite.RUtils/branch/main/graph/badge.svg)](https://codecov.io/gh/Open-Systems-Pharmacology/OSPSuite.RUtils?branch=main) +[![codecov](https://codecov.io/gh/Open-Systems-Pharmacology/OSPSuite.RUtils/branch/main/graph/badge.svg)](https://app.codecov.io/gh/Open-Systems-Pharmacology/OSPSuite.RUtils?branch=main) diff --git a/README.md b/README.md index 649809d..19a96f4 100644 --- a/README.md +++ b/README.md @@ -8,7 +8,7 @@ [![R build status](https://github.com/Open-Systems-Pharmacology/OSPSuite.RUtils/workflows/R-CMD-check/badge.svg)](https://github.com/Open-Systems-Pharmacology/OSPSuite.RUtils) [![pkgdown](https://github.com/Open-Systems-Pharmacology/OSPSuite.RUtils/workflows/pkgdown/badge.svg)](https://github.com/Open-Systems-Pharmacology/OSPSuite.RUtils/actions) -[![codecov](https://codecov.io/gh/Open-Systems-Pharmacology/OSPSuite.RUtils/branch/main/graph/badge.svg)](https://codecov.io/gh/Open-Systems-Pharmacology/OSPSuite.RUtils?branch=main) +[![codecov](https://codecov.io/gh/Open-Systems-Pharmacology/OSPSuite.RUtils/branch/main/graph/badge.svg)](https://app.codecov.io/gh/Open-Systems-Pharmacology/OSPSuite.RUtils?branch=main) diff --git a/cran-comments.md b/cran-comments.md index 04b8fa5..f715c7d 100644 --- a/cran-comments.md +++ b/cran-comments.md @@ -1,9 +1,6 @@ ## R CMD check results -0 errors | 0 warnings | 1 note +0 errors | 0 warnings | 0 note -* This is a new release. - -* We would like to retain the LICENSE files in the root directory for the ease - of accessibility from GitHub. +* Maintenance release. diff --git a/man/formatNumerics.Rd b/man/formatNumerics.Rd index 2b2ed33..2ab70ef 100644 --- a/man/formatNumerics.Rd +++ b/man/formatNumerics.Rd @@ -14,15 +14,15 @@ formatNumerics(object, digits = 2, scientific = FALSE) \item{scientific}{Logical value defining if scientific writing is rendered} } \value{ -Numeric values are rendered as character values. If \code{object} was a +Numeric values are rendered as character values. If \code{object} is a data.frame or a list, a data.frame or list is returned with numeric values rendered as character values. } \description{ -Render numeric values of an \code{object} using the specified format: +Render numeric values of an \code{object} as character using the specified format: \itemize{ \item If \code{object} is a data.frame or a list, \code{formatNumerics} applies on each of its fields -\item If \code{object} is of type character or integer, \code{formatNumerics} leaves the values as is +\item If \code{object} is of type character or integer, \code{formatNumerics} renders the values as is \item If \code{object} is of type numeric, \code{formatNumerics} applies the defined format } } diff --git a/man/hasUniqueValues.Rd b/man/hasOnlyDistinctValues.Rd similarity index 66% rename from man/hasUniqueValues.Rd rename to man/hasOnlyDistinctValues.Rd index 3e3869c..8ecbf3f 100644 --- a/man/hasUniqueValues.Rd +++ b/man/hasOnlyDistinctValues.Rd @@ -1,9 +1,12 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/error-checks.R -\name{hasUniqueValues} +\name{hasOnlyDistinctValues} +\alias{hasOnlyDistinctValues} \alias{hasUniqueValues} \title{Check that an array of values does not include any duplicate} \usage{ +hasOnlyDistinctValues(values, na.rm = TRUE) + hasUniqueValues(values, na.rm = TRUE) } \arguments{ @@ -19,8 +22,8 @@ Logical assessing if all values are unique Check that an array of values does not include any duplicate } \examples{ -hasUniqueValues(c("x", "y")) -hasUniqueValues(c("x", "y", "x")) -hasUniqueValues(c("x", NA, "y", NA), na.rm = FALSE) -hasUniqueValues(c("x", NA, "y", NA), na.rm = TRUE) +hasOnlyDistinctValues(c("x", "y")) +hasOnlyDistinctValues(c("x", "y", "x")) +hasOnlyDistinctValues(c("x", NA, "y", NA), na.rm = FALSE) +hasOnlyDistinctValues(c("x", NA, "y", NA), na.rm = TRUE) } diff --git a/man/isIncluded.Rd b/man/isIncluded.Rd index 7e4f474..c8ffb47 100644 --- a/man/isIncluded.Rd +++ b/man/isIncluded.Rd @@ -2,26 +2,39 @@ % Please edit documentation in R/error-checks.R \name{isIncluded} \alias{isIncluded} -\title{Check if input is included in a list} +\title{Check if a vector of values is included in another vector of values} \usage{ isIncluded(values, parentValues) } \arguments{ -\item{values}{Vector of values} +\item{values}{A vector of values.} -\item{parentValues}{Vector of values} +\item{parentValues}{A vector of values where \code{values} are checked for +inclusion.} } \value{ -\code{TRUE} if the values are inside the parent values. +Returns \code{TRUE} if the value or \strong{all} \code{values} (if it's a vector) are +present in the \code{parentValues}; \code{FALSE} otherwise. } \description{ -Check if input is included in a list +Check if a vector of values is included in another vector of values } \examples{ +# check if a column is present in dataframe A <- data.frame( col1 = c(1, 2, 3), col2 = c(4, 5, 6), col3 = c(7, 8, 9) ) -isIncluded("col3", names(A)) +isIncluded("col3", names(A)) # TRUE + +# check if single element is present in a vector (atomic or non-atomic) +isIncluded("x", list("w", "x", 1, 2)) # TRUE +isIncluded("x", c("w", "a", "y")) # FALSE + +# check if **all** values (if it's a vector) are contained in parent values +isIncluded(c("x", "y"), c("a", "y", "b", "x")) # TRUE +isIncluded(list("x", 1), list("a", "b", "x", 1)) # TRUE +isIncluded(c("x", "y"), c("a", "b", "x")) # FALSE +isIncluded(list("x", 1), list("a", "b", "x")) # FALSE } diff --git a/man/isSameLength.Rd b/man/isSameLength.Rd index 5fda9ab..fe78961 100644 --- a/man/isSameLength.Rd +++ b/man/isSameLength.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/error-checks.R \name{isSameLength} \alias{isSameLength} -\title{Check if two objects are of same length} +\title{Check if objects are of same length} \usage{ isSameLength(...) } @@ -10,9 +10,14 @@ isSameLength(...) \item{...}{Objects to compare.} } \description{ -Check if two objects are of same length +Check if objects are of same length } \examples{ -isSameLength(mtcars, ToothGrowth) -isSameLength(mtcars, mtcars) +# compare length of only 2 objects +isSameLength(mtcars, ToothGrowth) # FALSE +isSameLength(cars, BOD) # TRUE + +# or more number of objects +isSameLength(c(1, 2), c(TRUE, FALSE), c("x", "y")) # TRUE +isSameLength(list(1, 2), list(TRUE, FALSE), list("x")) # FALSE } diff --git a/man/validateIsIncluded.Rd b/man/validateIsIncluded.Rd index b1d553c..7d00cfb 100644 --- a/man/validateIsIncluded.Rd +++ b/man/validateIsIncluded.Rd @@ -7,9 +7,10 @@ validateIsIncluded(values, parentValues, nullAllowed = FALSE) } \arguments{ -\item{values}{Vector of values} +\item{values}{A vector of values.} -\item{parentValues}{Vector of values} +\item{parentValues}{A vector of values where \code{values} are checked for +inclusion.} \item{nullAllowed}{If \code{TRUE}, \code{value} can be \code{NULL} and the test always passes. If \code{FALSE} (default), \code{NULL} is not accepted and the test fails.} diff --git a/man/validateIsOfLength.Rd b/man/validateIsOfLength.Rd index f344406..4da99d0 100644 --- a/man/validateIsOfLength.Rd +++ b/man/validateIsOfLength.Rd @@ -2,36 +2,26 @@ % Please edit documentation in R/validation-helpers.R \name{validateIsOfLength} \alias{validateIsOfLength} -\alias{validateIsSameLength} \title{Check if objects have expected length} \usage{ validateIsOfLength(object, nbElements) - -validateIsSameLength(...) } \arguments{ \item{object}{An object or a list of objects} \item{nbElements}{number of elements that are supposed in object} - -\item{...}{Name of the variable in the calling function} } \value{ -If validations are successful, \code{NULL} is returned. Otherwise, the functions -will error. +If validations are successful, \code{NULL} is returned. Otherwise, error is +signaled. } \description{ Check if objects have expected length } \examples{ -A <- data.frame( - col1 = c(1, 2, 3), - col2 = c(4, 5, 6), - col3 = c(7, 8, 9) -) -validateIsSameLength(A, A) - -# returns NULL if of two objects are of same length -validateIsSameLength(list(1, 2), c(3, 4)) +# returns `NULL` if of objects are of specified length +validateIsOfLength(list(1, 2), 2L) +# error otherwise +# validateIsOfLength(c("3", "4"), 3L) } diff --git a/man/validateIsSameLength.Rd b/man/validateIsSameLength.Rd new file mode 100644 index 0000000..f74dd03 --- /dev/null +++ b/man/validateIsSameLength.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/validation-helpers.R +\name{validateIsSameLength} +\alias{validateIsSameLength} +\title{Check if all objects are of same length} +\usage{ +validateIsSameLength(...) +} +\arguments{ +\item{...}{Objects to compare.} +} +\value{ +If validations are successful, \code{NULL} is returned. Otherwise, error is +signaled. +} +\description{ +Check if all objects are of same length +} +\examples{ +# returns `NULL` if of objects are of same length +validateIsSameLength(list(1, 2), c("3", "4")) + +# error otherwise +# validateIsSameLength(list(1, 2), c("3", "4"), c(FALSE)) +} diff --git a/tests/testthat/test-error-checks.R b/tests/testthat/test-error-checks.R index a94fccf..a1db330 100644 --- a/tests/testthat/test-error-checks.R +++ b/tests/testthat/test-error-checks.R @@ -11,6 +11,12 @@ B <- data.frame( col4 = c(7, 8, 9) ) +x <- 1 +y <- 2 +z <- 3 + +a <- 1 + test_that("Checks if type 'is' and 'has' work properly", { # Output is logical expect_type(isSameLength(A, A), "logical") @@ -18,26 +24,42 @@ test_that("Checks if type 'is' and 'has' work properly", { expect_type(isOfType(A, "data.frame"), "logical") expect_type(isIncluded("col3", names(A)), "logical") - # Output is TRUE + # Output is `TRUE` expect_true(isSameLength(A, A)) + expect_true(isSameLength(c(1, 2), c("x", "y"), c(TRUE, FALSE))) + expect_true(isSameLength(list(1, 2), list("x", "y"), list(TRUE, FALSE))) expect_true(isOfLength(A, 3)) expect_true(isIncluded("col3", names(A))) + expect_true(isIncluded(2, 2)) + expect_true(isIncluded("x", list("w", "x", 1, 2))) + expect_true(isIncluded(c("x", "y"), c("a", "y", "b", "x"))) + expect_true(isIncluded(list("x", "y"), list("a", "b", "x", "y"))) + expect_true(isIncluded(a, list(x, y, z))) + expect_true(isIncluded(a, c(x, y, z))) expect_true(isOfType(A, "data.frame")) expect_true(isOfType(c(1, "x"), c("numeric", "character"))) expect_true(isOfType(NULL, nullAllowed = TRUE)) - # Output is FALSE + # Output is `FALSE` expect_false(isSameLength(A, B)) expect_false(isOfLength(A, 5)) + expect_false(isSameLength(c(1, 2), c("x"), c(TRUE, FALSE))) + expect_false(isSameLength(list(1, 2), list("x", "y"), list(FALSE))) expect_false(isOfType(A, "character")) expect_false(isIncluded("col4", names(A))) + expect_false(isIncluded(1, 2)) + expect_false(isIncluded("x", c("w", "a", "y"))) + expect_false(isIncluded(c("x", "y"), c("a", "b", "x"))) + expect_false(isIncluded(list("x", "y"), list("a", "b", "x"))) + expect_false(isIncluded(a, list(y, z))) + expect_false(isIncluded(a, c(y, z))) expect_false(isIncluded(NULL)) expect_false(isIncluded(character())) expect_equal(isOfType(NULL, nullAllowed = "a"), "a") - expect_true(hasUniqueValues(c("x", NA, "y"))) - expect_false(hasUniqueValues(c("x", NA, "y", "x"))) + expect_true(hasOnlyDistinctValues(c("x", NA, "y"))) + expect_false(hasOnlyDistinctValues(c("x", NA, "y", "x"))) expect_true(isFileExtension("enum.R", "R")) expect_false(isFileExtension("enum.R", "pkml")) diff --git a/tests/testthat/test-formatNumerics.R b/tests/testthat/test-formatNumerics.R index 1163a2d..bf976ed 100644 --- a/tests/testthat/test-formatNumerics.R +++ b/tests/testthat/test-formatNumerics.R @@ -1,12 +1,28 @@ -test_that("formatNumerics work as expected", { +test_that("formatNumerics returns character for integer, numeric or character objects", { + # integer + expect_type(formatNumerics(2L, digits = 1, scientific = TRUE), "character") + # numeric + expect_type(formatNumerics(2, digits = 1, scientific = TRUE), "character") + # character + expect_type(formatNumerics("2", digits = 1, scientific = TRUE), "character") +}) + + +test_that("formatNumerics works as expected", { + # integer and character as is + expect_equal(formatNumerics(2L, digits = 1, scientific = TRUE), "2") + expect_equal(formatNumerics("2", digits = 1, scientific = TRUE), "2") + # numeric is formated + expect_equal(formatNumerics(2, digits = 1, scientific = TRUE), "2.0e+00") + # vector x <- formatNumerics(log(c(12, 15, 0.3)), digits = 1, scientific = TRUE) expect_equal(x, c("2.5e+00", "2.7e+00", "-1.2e+00")) y <- formatNumerics(c(12L, 15L, 3L)) - expect_equal(y, c(12L, 15L, 3L)) + expect_equal(y, c("12", "15", "3")) - # dataframe + # data.frame df <- data.frame( parameter = c("a", "b", "c"), value = c(1, 110.4, 6.666), diff --git a/tests/testthat/test-validation-helpers.R b/tests/testthat/test-validation-helpers.R index 1e873f3..ebf9266 100644 --- a/tests/testthat/test-validation-helpers.R +++ b/tests/testthat/test-validation-helpers.R @@ -19,10 +19,13 @@ test_that("validateIsInteger works as expected", { expect_null(validateIsInteger(5L)) expect_null(validateIsInteger(c(1L, 5))) expect_null(validateIsInteger(c(1L, 5L))) + expect_null(validateIsInteger(list(1L, 5))) + expect_null(validateIsInteger(list(1L, 5L))) expect_null(validateIsInteger(NA_integer_)) # not integers, so should error expect_error(validateIsInteger(c(1.5, 5))) + expect_error(validateIsInteger(list(1.5, 5))) expect_error(validateIsInteger(2.4)) expect_error(validateIsInteger("2")) expect_error(validateIsInteger(TRUE)) @@ -65,14 +68,17 @@ test_that("Checks method of type 'validate' work properly", { expect_error(validateIsOfType(A, data.frame)) expect_null(validateIsIncluded("col3", names(A))) expect_null(validateIsIncluded(NULL, NULL, nullAllowed = TRUE)) - expect_null(validateIsString("x")) - expect_null(validateIsCharacter("x")) - expect_null(validateIsNumeric(1.2)) + expect_null(validateIsCharacter(c("x", "y"))) + expect_null(validateIsCharacter(list("x", "y"))) + expect_null(validateIsNumeric(c(1.2, 2.3))) + expect_null(validateIsNumeric(list(1.2, 2.3))) expect_null(validateIsNumeric(NULL, nullAllowed = TRUE)) expect_null(validateIsNumeric(c(NA, NULL))) expect_null(validateIsInteger(5)) expect_null(validateIsInteger(NULL, nullAllowed = TRUE)) expect_null(validateIsLogical(TRUE)) + expect_null(validateIsLogical(c(TRUE, FALSE))) + expect_null(validateIsLogical(list(TRUE, FALSE))) errorMessageIsSameLength <- "Arguments 'A, B' must have the same length, but they don't!" errorMessageIsOfLength <- "Object should be of length '5', but is of length '3' instead." @@ -95,3 +101,26 @@ test_that("enum validation works as expected", { expect_null(validateEnumValue(1, Symbol)) expect_error(validateEnumValue(4, Symbol)) }) + + +test_that("isInclude doesn't accept objects as arguments", { + Person <- R6::R6Class("Person", list( + name = NULL, + initialize = function(name) self$name <- name + )) + + Jack <- Person$new(name = "Jack") + Jill <- Person$new(name = "Jill") + + expect_error(isIncluded(Jack, Jill)) + expect_error(isIncluded(c(Jack), list(Jack, Jill))) +}) + +test_that("isInclude doesn't accept environments as arguments", { + e1 <- new.env() + e2 <- new.env() + + expect_error(isIncluded(e1, e2)) + expect_error(isIncluded(c(e1), c(e2))) + expect_error(isIncluded(c(e1), list(e2))) +})