From 318ce90a39a70b8c726df49a29f96db3582c52a4 Mon Sep 17 00:00:00 2001 From: nfrerebeau Date: Wed, 30 Aug 2023 13:01:21 +0200 Subject: [PATCH] Add tests --- R/AllGenerics.R | 2 + R/discard.R | 15 ++- R/keep.R | 16 ++- R/predicates.R | 4 + R/remove.R | 22 +--- R/replace.R | 10 +- inst/tinytest/test_clean.R | 239 ----------------------------------- inst/tinytest/test_compact.R | 67 ++++++++++ inst/tinytest/test_count.R | 27 ++++ inst/tinytest/test_detect.R | 27 ++++ inst/tinytest/test_discard.R | 36 ++++++ inst/tinytest/test_keep.R | 41 ++++++ inst/tinytest/test_remove.R | 73 +++++++++++ inst/tinytest/test_replace.R | 40 ++++++ man/keep.Rd | 31 ++++- man/remove_constant.Rd | 7 +- 16 files changed, 372 insertions(+), 285 deletions(-) delete mode 100644 inst/tinytest/test_clean.R create mode 100644 inst/tinytest/test_compact.R create mode 100644 inst/tinytest/test_count.R create mode 100644 inst/tinytest/test_detect.R create mode 100644 inst/tinytest/test_discard.R create mode 100644 inst/tinytest/test_keep.R create mode 100644 inst/tinytest/test_remove.R create mode 100644 inst/tinytest/test_replace.R diff --git a/R/AllGenerics.R b/R/AllGenerics.R index c0260e4..f1d9bff 100644 --- a/R/AllGenerics.R +++ b/R/AllGenerics.R @@ -51,6 +51,8 @@ setGeneric( #' #' Keeps rows/columns in an array-like object using a predicate function. #' @inheritParams detect +#' @param verbose A [`logical`] scalar: should \R report extra information +#' on progress? #' @example inst/examples/ex-keep.R #' @author N. Frerebeau #' @docType methods diff --git a/R/discard.R b/R/discard.R index ca21c9c..b85beec 100644 --- a/R/discard.R +++ b/R/discard.R @@ -11,11 +11,11 @@ setMethod( signature = c(x = "ANY"), definition = function(x, f, margin = 1, negate = FALSE, all = FALSE, verbose = getOption("arkhe.verbose"), ...) { - i <- !detect(x, f = f, margin = margin, negate = negate, all = all, ...) - discard_message(x, keep = i, margin = margin, verbose = verbose) - if (any(margin == 1)) return(x[i, , drop = FALSE]) - if (any(margin == 2)) return(x[, i, drop = FALSE]) - x + i <- detect(x, f = f, margin = margin, negate = negate, all = all, ...) + discard_message(x, keep = !i, margin = margin, verbose = verbose) + if (any(margin == 1)) return(x[!i, , drop = FALSE]) + if (any(margin == 2)) return(x[, !i, drop = FALSE]) + i } ) @@ -58,8 +58,9 @@ setMethod( discard_message <- function(x, keep, margin, verbose = getOption("arkhe.verbose")) { drop <- sum(!keep) - if (margin == 1) what <- ngettext(drop, "row", "rows") - if (margin == 2) what <- ngettext(drop, "column", "columns") + what <- ngettext(drop, "element", "elements") + if (any(margin == 1)) what <- ngettext(drop, "row", "rows") + if (any(margin == 2)) what <- ngettext(drop, "column", "columns") if (drop == 0) { msg <- sprintf("No %s to remove.", what) diff --git a/R/keep.R b/R/keep.R index 539a282..a254023 100644 --- a/R/keep.R +++ b/R/keep.R @@ -9,11 +9,13 @@ NULL setMethod( f = "keep", signature = c(x = "ANY"), - definition = function(x, f, margin = 1, negate = FALSE, all = FALSE, ...) { + definition = function(x, f, margin = 1, negate = FALSE, all = FALSE, + verbose = getOption("arkhe.verbose"), ...) { i <- detect(x, f = f, margin = margin, negate = negate, all = all, ...) + discard_message(x, keep = i, margin = margin, verbose = verbose) if (any(margin == 1)) return(x[i, , drop = FALSE]) if (any(margin == 2)) return(x[, i, drop = FALSE]) - x + i } ) @@ -23,8 +25,9 @@ setMethod( setMethod( f = "keep_rows", signature = c(x = "ANY"), - definition = function(x, f, negate = FALSE, all = FALSE, ...) { - keep(x, f, margin = 1, negate = negate, all = all, ...) + definition = function(x, f, negate = FALSE, all = FALSE, + verbose = getOption("arkhe.verbose"), ...) { + keep(x, f, margin = 1, negate = negate, all = all, verbose = verbose, ...) } ) @@ -34,7 +37,8 @@ setMethod( setMethod( f = "keep_cols", signature = c(x = "ANY"), - definition = function(x, f, negate = FALSE, all = FALSE, ...) { - keep(x, f, margin = 2, negate = negate, all = all, ...) + definition = function(x, f, negate = FALSE, all = FALSE, + verbose = getOption("arkhe.verbose"), ...) { + keep(x, f, margin = 2, negate = negate, all = all, verbose = verbose, ...) } ) diff --git a/R/predicates.R b/R/predicates.R index bcea1c6..a57cb0d 100644 --- a/R/predicates.R +++ b/R/predicates.R @@ -1,6 +1,10 @@ # PREDICATES # Not exported ================================================================= +is_unique <- function(x, na.rm = FALSE) { + if (na.rm) x <- stats::na.omit(x) + length(unique(x)) <= 1 +} is_empty_string <- function(x, na.rm = FALSE) { assert_type(x, "character") if (na.rm) x <- stats::na.omit(x) diff --git a/R/remove.R b/R/remove.R index 3bf0dec..24e22e4 100644 --- a/R/remove.R +++ b/R/remove.R @@ -53,27 +53,11 @@ setMethod( # Constant ===================================================================== #' @export #' @rdname remove_constant -#' @aliases remove_constant,data.frame-method +#' @aliases remove_constant,ANY-method setMethod( f = "remove_constant", - signature = c(x = "data.frame"), - definition = function(x, na.rm = FALSE) { - all_unique <- function(x) { - if (na.rm) x <- stats::na.omit(x) - length(unique(x)) <= 1 - } - discard(x, f = all_unique, margin = 2, all = FALSE) - } -) - -#' @export -#' @rdname remove_constant -#' @aliases remove_constant,matrix-method -setMethod( - f = "remove_constant", - signature = c(x = "matrix"), + signature = c(x = "ANY"), definition = function(x, na.rm = FALSE) { - x <- as.data.frame(x) - methods::callGeneric(x, na.rm = na.rm) + discard(x, f = function(x) { is_unique(x, na.rm) }, margin = 2, all = FALSE) } ) diff --git a/R/replace.R b/R/replace.R index 8dd1ed5..651d278 100644 --- a/R/replace.R +++ b/R/replace.R @@ -88,13 +88,12 @@ setMethod( signature = c(x = "data.frame"), definition = function(x, value) { num <- vapply(X = x, FUN = is.numeric, FUN.VALUE = logical(1)) - nozero <- vapply( - X = x[, num], + nozero <- lapply( + X = x[, num, drop = FALSE], FUN = function(x, value) { x[is_zero(x)] <- value x }, - FUN.VALUE = numeric(nrow(x)), value = value ) x[, num] <- nozero @@ -123,13 +122,12 @@ setMethod( signature = c(x = "data.frame"), definition = function(x, value) { char <- vapply(X = x, FUN = is.character, FUN.VALUE = logical(1)) - noblank <- vapply( - X = x[, char], + noblank <- lapply( + X = x[, char, drop = FALSE], FUN = function(x, value) { x[is_empty_string(x)] <- value x }, - FUN.VALUE = character(nrow(x)), value = value ) x[, char] <- noblank diff --git a/inst/tinytest/test_clean.R b/inst/tinytest/test_clean.R deleted file mode 100644 index 8ba086f..0000000 --- a/inst/tinytest/test_clean.R +++ /dev/null @@ -1,239 +0,0 @@ -mtx <- matrix(c(8L, 10L, 1L, 10L, 2L, - 5L, 10L, 10L, 3L, 3L, - 6L, 8L, 4L, 4L, 8L), - nrow = 5, ncol = 3) - -mtxNA <- matrix(c(8L, NA, 1L, NA, 2L, - 5L, 10L, 10L, 3L, 3L, - 6L, 8L, NA, 4L, 8L), - nrow = 5, ncol = 3) - -dfNA <- data.frame( - V1 = c("A", NA, "B", NA, "C"), - V2 = c(10L, 6L, 6L, 1L, 4L), - V3 = c(2L, 1L, NA, 5L, 9L) -) - -# Count ======================================================================== -## Count missing values in rows -expect_equal(count(mtxNA, f = is.na, margin = 1), c(0, 1, 1, 1, 0)) -## Count non-missing values in columns -no_na <- count(mtxNA, f = is.na, margin = 2, negate = TRUE) -expect_equal(no_na, c(V1 = 3, V2 = 5, V3 = 4)) - -## Count missing values in rows -expect_equal(count(dfNA, f = is.na, margin = 1), c(0, 1, 1, 1, 0)) -## Count non-missing values in columns -no_na <- count(dfNA, f = is.na, margin = 2, negate = TRUE) -expect_equal(no_na, c(V1 = 3, V2 = 5, V3 = 4)) - -# Detect ======================================================================= -## Find row with NA -expect_equal(detect(mtxNA, f = is.na, margin = 1), c(FALSE, TRUE, TRUE, TRUE, FALSE)) -## Find column without any NA -no_na <- detect(mtxNA, f = is.na, margin = 2, negate = TRUE, all = TRUE) -expect_equal(no_na, c(V1 = FALSE, V2 = TRUE, V3 = FALSE)) - -## Find row with NA -expect_equal(detect(dfNA, f = is.na, margin = 1), c(FALSE, TRUE, TRUE, TRUE, FALSE)) -## Find column without any NA -no_na <- detect(dfNA, f = is.na, margin = 2, negate = TRUE, all = TRUE) -expect_equal(no_na, c(V1 = FALSE, V2 = TRUE, V3 = FALSE)) - -# Discard ====================================================================== -# Nothing to remove -clean <- discard_rows(mtx, f = is_zero, all = FALSE) -expect_equal(dim(clean), dim(mtx)) - -mtx0 <- mtx -mtx0[1, ] <- 0 # Add zeros - -# Nothing to remove -clean <- discard_cols(mtx0, f = is_zero, all = TRUE) -expect_equal(dim(clean), dim(mtx0)) - -mtx0[, 1] <- 0 # Add zeros - -# Remove rows -clean_row <- discard_rows(mtx0, f = is_zero, all = TRUE) -expect_true(nrow(clean_row) < nrow(mtx0)) -expect_equal(ncol(clean_row), ncol(mtx0)) - -# Remove columns -clean_col <- discard_cols(mtx0, f = is_zero, all = TRUE) -expect_true(ncol(clean_col) < ncol(mtx0)) -expect_equal(nrow(clean_col), nrow(mtx0)) - -# Keep ========================================================================= -# Nothing to keep -clean <- keep_rows(mtx, f = is_zero, all = FALSE) -expect_equal(dim(clean), c(0, 3)) - -mtx0 <- mtx -mtx0[1, ] <- 0 # Add zeros - -# Nothing to keep -clean <- keep_cols(mtx0, f = is_zero, all = TRUE) -expect_equal(dim(clean), c(5, 0)) - -mtx0[, 1] <- 0 # Add zeros - -# Keep all -clean_row <- keep_rows(mtx0, f = is_zero, all = FALSE) -expect_equal(dim(clean_row), dim(mtx0)) - -clean_col <- keep_cols(mtx0, f = is_zero, all = FALSE) -expect_equal(dim(clean_col), dim(mtx0)) - -# Remove rows -clean_row <- keep_rows(mtx0, f = is_zero, all = TRUE) -expect_equal(dim(clean_row), c(1, 3)) - -# Remove columns -clean_col <- keep_cols(mtx0, f = is_zero, all = TRUE) -expect_equal(dim(clean_col), c(5, 1)) - -# Missing values =============================================================== -## Replace missing values ------------------------------------------------------ -clean <- replace_NA(mtxNA, value = 999) -expect_equal(sum(clean == 999), 3) - -## Remove missing values ------------------------------------------------------- -# Nothing to remove -clean <- remove_NA(mtx, margin = 1) -expect_equal(dim(clean), dim(mtx)) - -# Remove rows -clean_row <- remove_NA(mtxNA, margin = 1) -expect_true(nrow(clean_row) < nrow(mtxNA)) -expect_true(nrow(clean_row) > 0) -expect_equal(ncol(clean_row), ncol(mtxNA)) - -# Remove columns -clean_col <- remove_NA(mtxNA, margin = 2) -expect_true(ncol(clean_col) < ncol(mtxNA)) -expect_true(ncol(clean_col) > 0) -expect_equal(nrow(clean_col), nrow(mtxNA)) - -# Infinite values ============================================================== -mtxInf <- mtx -mtxInf[sample(1:15, 3, FALSE)] <- Inf # Add infinite values - -## Replace infinite values ----------------------------------------------------- -clean <- replace_Inf(mtxInf, value = 999) -expect_equal(sum(clean == 999), 3) - -## Remove infinite values ------------------------------------------------------ -# Nothing to remove -clean <- remove_Inf(mtx, margin = 1) -expect_equal(dim(clean), dim(mtx)) - -# Remove rows -clean_row <- remove_Inf(mtxInf, margin = 1) -expect_true(nrow(clean_row) < nrow(mtxInf)) -expect_equal(ncol(clean_row), ncol(mtxInf)) - -# Remove columns -clean_col <- remove_Inf(mtxInf, margin = 2) -expect_true(ncol(clean_col) < ncol(mtxInf)) -expect_equal(nrow(clean_col), nrow(mtxInf)) - -# Zeros ======================================================================== -mtx0 <- mtx -mtx0[sample(1:15, 3, FALSE)] <- 0 # Add zeros - -## Replace zeros --------------------------------------------------------------- -clean <- replace_zero(mtx0, value = 999) -expect_equal(sum(clean == 999), 3) - -## Remove zeros ---------------------------------------------------------------- -# Nothing to remove -clean <- remove_zero(mtx, margin = 1) -expect_equal(dim(clean), dim(mtx)) - -# Remove rows -clean_row <- remove_zero(mtx0, margin = 1) -expect_true(nrow(clean_row) < nrow(mtx0)) -expect_equal(ncol(clean_row), ncol(mtx0)) - -# Remove columns -clean_col <- remove_zero(mtx0, margin = 2) -expect_true(ncol(clean_col) < ncol(mtx0)) -expect_equal(nrow(clean_col), nrow(mtx0)) - -# Constant columns ============================================================= -df1 <- data.frame(A = 1, B = 1:3) -df2 <- data.frame(B = 1:3) - -expect_equal(remove_constant(df1), df2) - -df1[1, 1] <- NA # Add NA -expect_equal(remove_constant(df1), df1) - -expect_equal(remove_constant(df1, na.rm = TRUE), df2) - -# Empty rows/columns =========================================================== -## Compact (numeric) ----------------------------------------------------------- -# Nothing to remove -clean <- compact_rows(mtx) -expect_equal(dim(clean), dim(mtx)) - -mtx0 <- mtx -mtx0[1, ] <- 0 # Add zeros -mtx0[, 1] <- 0 # Add zeros - -# Remove rows -clean_row <- compact_rows(mtx0) -expect_equal(nrow(clean_row), 4) -expect_equal(ncol(clean_row), ncol(mtx0)) - -# Remove columns -clean_col <- compact_cols(mtx0) -expect_equal(ncol(clean_col), 2) -expect_equal(nrow(clean_col), nrow(mtx0)) - -## Compact (character) --------------------------------------------------------- -char <- as.character(mtx) -dim(char) <- dim(mtx) - -# Nothing to remove -clean <- compact_rows(char) -expect_equal(dim(clean), dim(char)) - -charBlank <- char -charBlank[1, ] <- "" # Add blank -charBlank[, 1] <- "" # Add blank - -# Remove rows -clean_row <- compact_rows(charBlank) -expect_equal(nrow(clean_row), 4) -expect_equal(ncol(clean_row), ncol(charBlank)) - -# Remove columns -clean_col <- compact_cols(charBlank) -expect_equal(ncol(clean_col), 2) -expect_equal(nrow(clean_col), nrow(charBlank)) - -## Compact (logical) ----------------------------------------------------------- -bin <- matrix(c(FALSE, TRUE, TRUE, TRUE, FALSE, - FALSE, TRUE, FALSE, FALSE, TRUE, - FALSE, FALSE, FALSE, TRUE, FALSE), - nrow = 5, ncol = 3) - -# Nothing to remove -clean <- compact_rows(bin) -expect_equal(dim(clean), dim(bin)) - -binNA <- bin -binNA[1, ] <- NA # Add NA -binNA[, 1] <- NA # Add NA - -# Remove rows -clean_row <- compact_rows(binNA) -expect_equal(nrow(clean_row), 4) -expect_equal(ncol(clean_row), ncol(binNA)) - -# Remove columns -clean_col <- compact_cols(binNA) -expect_equal(ncol(clean_col), 2) -expect_equal(nrow(clean_col), nrow(binNA)) diff --git a/inst/tinytest/test_compact.R b/inst/tinytest/test_compact.R new file mode 100644 index 0000000..f3dd3d9 --- /dev/null +++ b/inst/tinytest/test_compact.R @@ -0,0 +1,67 @@ +mtx <- matrix(c(8L, 10L, 1L, 10L, 2L, 5L, 10L, 10L, 3L, 3L, 6L, 8L, 4L, 4L, 8L), + nrow = 5, ncol = 3) + +# Compact (numeric) ============================================================ +## Nothing to remove +clean <- compact_rows(mtx) +expect_equal(dim(clean), dim(mtx)) + +mtx0 <- mtx +mtx0[1, ] <- 0 # Add zeros +mtx0[, 1] <- 0 # Add zeros + +## Remove rows +clean_row <- compact_rows(mtx0) +expect_equal(nrow(clean_row), 4) +expect_equal(ncol(clean_row), ncol(mtx0)) + +## Remove columns +clean_col <- compact_cols(mtx0) +expect_equal(ncol(clean_col), 2) +expect_equal(nrow(clean_col), nrow(mtx0)) + +# Compact (character) ========================================================== +char <- as.character(mtx) +dim(char) <- dim(mtx) + +## Nothing to remove +clean <- compact_rows(char) +expect_equal(dim(clean), dim(char)) + +charBlank <- char +charBlank[1, ] <- "" # Add blank +charBlank[, 1] <- "" # Add blank + +## Remove rows +clean_row <- compact_rows(charBlank) +expect_equal(nrow(clean_row), 4) +expect_equal(ncol(clean_row), ncol(charBlank)) + +## Remove columns +clean_col <- compact_cols(charBlank) +expect_equal(ncol(clean_col), 2) +expect_equal(nrow(clean_col), nrow(charBlank)) + +# Compact (logical) ============================================================ +bin <- matrix(c(FALSE, TRUE, TRUE, TRUE, FALSE, + FALSE, TRUE, FALSE, FALSE, TRUE, + FALSE, FALSE, FALSE, TRUE, FALSE), + nrow = 5, ncol = 3) + +## Nothing to remove +clean <- compact_rows(bin) +expect_equal(dim(clean), dim(bin)) + +binNA <- bin +binNA[1, ] <- NA # Add NA +binNA[, 1] <- NA # Add NA + +## Remove rows +clean_row <- compact_rows(binNA) +expect_equal(nrow(clean_row), 4) +expect_equal(ncol(clean_row), ncol(binNA)) + +## Remove columns +clean_col <- compact_cols(binNA) +expect_equal(ncol(clean_col), 2) +expect_equal(nrow(clean_col), nrow(binNA)) diff --git a/inst/tinytest/test_count.R b/inst/tinytest/test_count.R new file mode 100644 index 0000000..b51c916 --- /dev/null +++ b/inst/tinytest/test_count.R @@ -0,0 +1,27 @@ +# matrix ======================================================================= +mtx <- matrix(c(8L, NA, 1L, NA, 2L, 5L, 10L, 10L, 3L, 3L, 6L, 8L, NA, 4L, 8L), + nrow = 5, ncol = 3) + +## Count missing values in rows +expect_equal(count(mtx, f = is.na, margin = 1), c(0, 1, 1, 1, 0)) +## Count non-missing values in columns +no_na <- count(mtx, f = is.na, margin = 2, negate = TRUE) +expect_equal(no_na, c(V1 = 3, V2 = 5, V3 = 4)) + +# data.frame =================================================================== +df <- data.frame( + V1 = c("A", NA, "B", NA, "C"), + V2 = c(10L, 6L, 6L, 1L, 4L), + V3 = c(2L, 1L, NA, 5L, 9L) +) + +## Count missing values in rows +expect_equal(count(df, f = is.na, margin = 1), c(0, 1, 1, 1, 0)) +## Count non-missing values in columns +no_na <- count(df, f = is.na, margin = 2, negate = TRUE) +expect_equal(no_na, c(V1 = 3, V2 = 5, V3 = 4)) + +## No margin +test <- df +test[] <- lapply(X = df, FUN = is.na) +expect_equal(count(df, f = is.na, margin = NULL), test) diff --git a/inst/tinytest/test_detect.R b/inst/tinytest/test_detect.R new file mode 100644 index 0000000..db42fb8 --- /dev/null +++ b/inst/tinytest/test_detect.R @@ -0,0 +1,27 @@ +# matrix ======================================================================= +mtx <- matrix(c(8L, NA, 1L, NA, 2L, 5L, 10L, 10L, 3L, 3L, 6L, 8L, NA, 4L, 8L), + nrow = 5, ncol = 3) + +## Find row with NA +expect_equal(detect(mtx, f = is.na, margin = 1), c(FALSE, TRUE, TRUE, TRUE, FALSE)) + +## Find column without any NA +no_na <- detect(mtx, f = is.na, margin = 2, negate = TRUE, all = TRUE) +expect_equal(no_na, c(V1 = FALSE, V2 = TRUE, V3 = FALSE)) + +# data.frame =================================================================== +df <- data.frame( + V1 = c("A", NA, "B", NA, "C"), + V2 = c(10L, 6L, 6L, 1L, 4L), + V3 = c(2L, 1L, NA, 5L, 9L) +) + +## Find row with NA +expect_equal(detect(df, f = is.na, margin = 1), c(FALSE, TRUE, TRUE, TRUE, FALSE)) + +## Find column without any NA +no_na <- detect(df, f = is.na, margin = 2, negate = TRUE, all = TRUE) +expect_equal(no_na, c(V1 = FALSE, V2 = TRUE, V3 = FALSE)) + +## Find numeric column +expect_equal(detect(df, f = is.numeric, margin = 2), c(V1 = FALSE, V2 = TRUE, V3 = TRUE)) diff --git a/inst/tinytest/test_discard.R b/inst/tinytest/test_discard.R new file mode 100644 index 0000000..d76f4db --- /dev/null +++ b/inst/tinytest/test_discard.R @@ -0,0 +1,36 @@ +mtx <- matrix(c(8L, 10L, 1L, 10L, 2L, 5L, 10L, 10L, 3L, 3L, 6L, 8L, 4L, 4L, 8L), + nrow = 5, ncol = 3) + +## Nothing to remove +clean <- discard_rows(mtx, f = is_zero, all = FALSE) +expect_equal(dim(clean), dim(mtx)) +expect_message(discard_rows(mtx, f = is_zero, verbose = TRUE), + "No rows to remove") + +mtx[1, ] <- 0 # Add zeros + +## Nothing to remove +clean <- discard_cols(mtx, f = is_zero, all = TRUE) +expect_equal(dim(clean), dim(mtx)) +expect_message(discard_cols(mtx, f = is_zero, all = TRUE, verbose = TRUE), + "No columns to remove") + +mtx[, 1] <- 0 # Add zeros + +## Remove rows +clean_row <- discard_rows(mtx, f = is_zero, all = TRUE) +expect_equal(nrow(clean_row), nrow(mtx) - 1L) +expect_equal(ncol(clean_row), ncol(mtx)) +expect_message(discard_rows(mtx, f = is_zero, all = TRUE, verbose = TRUE), + "Removing 1 row out of 5") + +## Remove columns +clean_col <- discard_cols(mtx, f = is_zero, all = TRUE) +expect_equal(ncol(clean_col), ncol(mtx) - 1L) +expect_equal(nrow(clean_col), nrow(mtx)) +expect_message(discard_cols(mtx, f = is_zero, all = TRUE, verbose = TRUE), + "Removing 1 column out of 3") + +## No margin +test <- apply(X = mtx, MARGIN = 2, FUN = is_zero) +expect_equivalent(discard(mtx, f = is_zero, margin = NULL), test) diff --git a/inst/tinytest/test_keep.R b/inst/tinytest/test_keep.R new file mode 100644 index 0000000..a3db7f0 --- /dev/null +++ b/inst/tinytest/test_keep.R @@ -0,0 +1,41 @@ +mtx <- matrix(c(8L, 10L, 1L, 10L, 2L, 5L, 10L, 10L, 3L, 3L, 6L, 8L, 4L, 4L, 8L), + nrow = 5, ncol = 3) + +# Nothing to keep +clean <- keep_rows(mtx, f = is_zero, all = FALSE) +expect_equal(dim(clean), c(0, 3)) + +mtx[1, ] <- 0 # Add zeros + +# Nothing to keep +clean <- keep_cols(mtx, f = is_zero, all = TRUE) +expect_equal(dim(clean), c(5, 0)) + +mtx[, 1] <- 0 # Add zeros + +# Keep all +clean_row <- keep_rows(mtx, f = is_zero, all = FALSE) +expect_equal(clean_row, mtx) +expect_message(keep_rows(mtx, f = is_zero, verbose = TRUE), + "No rows to remove") + +clean_col <- keep_cols(mtx, f = is_zero, all = FALSE) +expect_equal(clean_col, mtx) +expect_message(keep_cols(mtx, f = is_zero, verbose = TRUE), + "No columns to remove") + +# Remove rows +clean_row <- keep_rows(mtx, f = is_zero, all = TRUE) +expect_equal(dim(clean_row), c(1, 3)) +expect_message(keep_rows(mtx, f = is_zero, all = TRUE, verbose = TRUE), + "Removing 4 rows out of 5") + +# Remove columns +clean_col <- keep_cols(mtx, f = is_zero, all = TRUE) +expect_equal(dim(clean_col), c(5, 1)) +expect_message(keep_cols(mtx, f = is_zero, all = TRUE, verbose = TRUE), + "Removing 2 columns out of 3") + +## No margin +test <- apply(X = mtx, MARGIN = 2, FUN = is_zero) +expect_equivalent(keep(mtx, f = is_zero, margin = NULL), test) diff --git a/inst/tinytest/test_remove.R b/inst/tinytest/test_remove.R new file mode 100644 index 0000000..2d83fae --- /dev/null +++ b/inst/tinytest/test_remove.R @@ -0,0 +1,73 @@ +mtx <- matrix(c(8L, 10L, 1L, 10L, 2L, 5L, 10L, 10L, 3L, 3L, 6L, 8L, 4L, 4L, 8L), + nrow = 5, ncol = 3) + +mtxZero <- mtxInf <- mtxNA <- mtx +mtxNA[c(1, 4, 13)] <- NA +mtxInf[c(1, 4, 13)] <- Inf +mtxZero[c(1, 4, 13)] <- 0 + +mtxEmpty <- apply(X = mtx, MARGIN = 2, FUN = as.character) +mtxEmpty[c(1, 4, 13)] <- "" + +# Missing values =============================================================== +## Nothing to remove +clean <- remove_NA(mtx, margin = 1) +expect_equal(dim(clean), dim(mtx)) + +## Remove rows +clean_row <- remove_NA(mtxNA, margin = 1) +expect_equal(dim(clean_row), c(2, 3)) + +## Remove columns +clean_col <- remove_NA(mtxNA, margin = 2) +expect_equal(dim(clean_col), c(5, 1)) + +# Infinite values ============================================================== +## Nothing to remove +clean <- remove_Inf(mtx, margin = 1) +expect_equal(dim(clean), dim(mtx)) + +## Remove rows +clean_row <- remove_Inf(mtxInf, margin = 1) +expect_equal(dim(clean_row), c(2, 3)) + +## Remove columns +clean_col <- remove_Inf(mtxInf, margin = 2) +expect_equal(dim(clean_col), c(5, 1)) + +# Zeros ======================================================================== +## Nothing to remove +clean <- remove_zero(mtxZero, margin = 2, all = TRUE) +expect_equal(clean, mtxZero) + +## Remove rows +clean_row <- remove_zero(mtxZero, margin = 1) +expect_equal(dim(clean_row), c(2, 3)) + +## Remove columns +clean_col <- remove_zero(mtxZero, margin = 2) +expect_equal(dim(clean_col), c(5, 1)) + +# Empty strings ================================================================ +## Nothing to remove +clean <- remove_empty(mtxEmpty, margin = 2, all = TRUE) +expect_equal(clean, mtxEmpty) + +## Remove rows +clean_row <- remove_empty(mtxEmpty, margin = 1) +expect_equal(dim(clean_row), c(2, 3)) + +## Remove columns +clean_col <- remove_empty(mtxEmpty, margin = 2) +expect_equal(dim(clean_col), c(5, 1)) + +# Constant columns ============================================================= +df1 <- data.frame(A = 1, B = 1:3) +df2 <- data.frame(B = 1:3) + +expect_equal(remove_constant(df1), df2) + +df1[1, 1] <- NA # Add NA +expect_equal(remove_constant(df1), df1) + +expect_equal(remove_constant(df1, na.rm = TRUE), df2) diff --git a/inst/tinytest/test_replace.R b/inst/tinytest/test_replace.R new file mode 100644 index 0000000..8197250 --- /dev/null +++ b/inst/tinytest/test_replace.R @@ -0,0 +1,40 @@ +mtx <- matrix(c(8L, 10L, 1L, 10L, 2L, 5L, 10L, 10L, 3L, 3L, 6L, 8L, 4L, 4L, 8L), + nrow = 5, ncol = 3) + +mtxZero <- mtxInf <- mtxNA <- mtx +mtxNA[c(1, 4, 13)] <- NA +mtxInf[c(1, 4, 13)] <- Inf +mtxZero[c(1, 4, 13)] <- 0 + +mtxEmpty <- apply(X = mtx, MARGIN = 2, FUN = as.character) +mtxEmpty[c(1, 4, 13)] <- "" + +# Missing values =============================================================== +clean <- replace_NA(mtxNA, value = 999) +expect_equal(sum(clean == 999), 3) + +# Infinite values ============================================================== +clean <- replace_Inf(mtxInf, value = 999) +expect_equal(sum(clean == 999), 3) + +# Zeros ======================================================================== +clean <- replace_zero(mtxZero, value = 999) +expect_equal(sum(clean == 999), 3) + +# Empty strings ================================================================ +clean <- replace_empty(mtxEmpty, value = "XXX") +expect_equal(sum(clean == "XXX"), 3) + +df <- data.frame( + V1 = c("A", "", "B", "C", "D"), + V2 = c(1L, Inf, 3L, 4L, 5L), + V3 = c(0.0, 1.1, NA, 3.3, 4.4) +) +df <- replace_NA(df, value = 999) +df <- replace_Inf(df, value = 888L) +df <- replace_zero(df, value = 777) +df <- replace_empty(df, value = "XXX") + +expect_equal(df, data.frame(V1 = c("A", "XXX", "B", "C", "D"), + V2 = c(1L, 888L, 3L, 4L, 5L), + V3 = c(777.0, 1.1, 999.0, 3.3, 4.4))) diff --git a/man/keep.Rd b/man/keep.Rd index 225e0e2..a087f41 100644 --- a/man/keep.Rd +++ b/man/keep.Rd @@ -19,11 +19,33 @@ keep_cols(x, ...) keep_rows(x, ...) -\S4method{keep}{ANY}(x, f, margin = 1, negate = FALSE, all = FALSE, ...) +\S4method{keep}{ANY}( + x, + f, + margin = 1, + negate = FALSE, + all = FALSE, + verbose = getOption("arkhe.verbose"), + ... +) -\S4method{keep_rows}{ANY}(x, f, negate = FALSE, all = FALSE, ...) +\S4method{keep_rows}{ANY}( + x, + f, + negate = FALSE, + all = FALSE, + verbose = getOption("arkhe.verbose"), + ... +) -\S4method{keep_cols}{ANY}(x, f, negate = FALSE, all = FALSE, ...) +\S4method{keep_cols}{ANY}( + x, + f, + negate = FALSE, + all = FALSE, + verbose = getOption("arkhe.verbose"), + ... +) } \arguments{ \item{x}{An \R object (should be a \code{\link{matrix}} or a \code{\link{data.frame}}).} @@ -42,6 +64,9 @@ instead of \code{f}?} values all meet the condition defined by \code{f} are considered. If \code{FALSE} (the default), only rows/columns where at least one value validates the condition defined by \code{f} are considered.} + +\item{verbose}{A \code{\link{logical}} scalar: should \R report extra information +on progress?} } \description{ Keeps rows/columns in an array-like object using a predicate function. diff --git a/man/remove_constant.Rd b/man/remove_constant.Rd index 6ebf4e3..d6fc56d 100644 --- a/man/remove_constant.Rd +++ b/man/remove_constant.Rd @@ -4,15 +4,12 @@ \name{remove_constant} \alias{remove_constant} \alias{remove_constant-method} -\alias{remove_constant,data.frame-method} -\alias{remove_constant,matrix-method} +\alias{remove_constant,ANY-method} \title{Remove Constant Columns} \usage{ remove_constant(x, ...) -\S4method{remove_constant}{data.frame}(x, na.rm = FALSE) - -\S4method{remove_constant}{matrix}(x, na.rm = FALSE) +\S4method{remove_constant}{ANY}(x, na.rm = FALSE) } \arguments{ \item{x}{An \R object (should be a \code{\link{matrix}} or a \code{\link{data.frame}}).}