tests/rowVarDiffs.R

In matrixStats: Functions that Apply to Rows and Columns of Matrices (and to Vectors)

library("matrixStats")

fcns <- list(
  rowVarDiffs = list(rowVarDiffs, colVarDiffs),
  rowSdDiffs  = list(rowSdDiffs, colSdDiffs),
  rowMadDiffs = list(rowMadDiffs, colMadDiffs),
  rowIQRDiffs = list(rowIQRDiffs, colIQRDiffs)
)

for (fcn in names(fcns)) {
  cat(sprintf("%s()...\n", fcn))
  row_fcn <- fcns[[fcn]][[1L]]
  col_fcn <- fcns[[fcn]][[2L]]

  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  # With and without some NAs
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  for (mode in c("integer", "double")) {
    for (add_na in c(FALSE, TRUE)) {
      cat("add_na = ", add_na, "\n", sep = "")

      x <- matrix(1:50 + 0.1, nrow = 10L, ncol = 5L)
      if (add_na) {
        x[3:7, c(2, 4)] <- NA_real_
      }
      cat("mode: ", mode, "\n", sep = "")
      storage.mode(x) <- mode
      str(x)
      
      # To check names attribute
      dimnames <- list(letters[1:10], LETTERS[1:5])

      # Test with and without dimnames on x
      for (setDimnames in c(TRUE, FALSE)) {
        if (setDimnames) dimnames(x) <- dimnames
        else dimnames(x) <- NULL
        # Row/column ranges
        for (na.rm in c(FALSE, TRUE)) {
          # Check names attribute
          for (useNames in c(if (!matrixStats:::isUseNamesNADefunct()) NA, TRUE, FALSE)) {
            cat("na.rm = ", na.rm, "\n", sep = "")
            r1 <- row_fcn(x, na.rm = na.rm, useNames = useNames)
            r2 <- col_fcn(t(x), na.rm = na.rm, useNames = useNames)
            stopifnot(all.equal(r1, r2))
          }
        }
      }
    } # for (add_na ...)
  }


  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  # All NAs
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  for (mode in c("integer", "double")) {
    x <- matrix(NA_real_, nrow = 10L, ncol = 5L)
    cat("mode: ", mode, "\n", sep = "")
    storage.mode(x) <- mode
    str(x)

    # Test with and without dimnames on x
    for (setDimnames in c(TRUE, FALSE)) {
      if (setDimnames) dimnames(x) <- dimnames
      else dimnames(x) <- NULL
      # Row/column ranges
      for (na.rm in c(FALSE, TRUE)) {
        # Check names attribute
        for (useNames in c(if (!matrixStats:::isUseNamesNADefunct()) NA, TRUE, FALSE)) {
          cat("na.rm = ", na.rm, "\n", sep = "")
          r1 <- row_fcn(x, na.rm = na.rm, useNames = useNames)
          r2 <- col_fcn(t(x), na.rm = na.rm, useNames = useNames)
          stopifnot(all.equal(r1, r2))
        }
      }
    }
  }


  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  # A 1x1 matrix
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  x <- matrix(0, nrow = 1L, ncol = 1L)
  dimnames <- list("a", "A")
  # Test with and without dimnames on x
  for (setDimnames in c(TRUE, FALSE)) {
    if (setDimnames) dimnames(x) <- dimnames
    else dimnames(x) <- NULL
    # Row/column ranges
    for (na.rm in c(FALSE, TRUE)) {
      # Check names attribute
      for (useNames in c(if (!matrixStats:::isUseNamesNADefunct()) NA, TRUE, FALSE)) {
        cat("na.rm = ", na.rm, "\n", sep = "")
        r1 <- row_fcn(x, na.rm = na.rm, useNames = useNames)
        r2 <- col_fcn(t(x), na.rm = na.rm, useNames = useNames)
        stopifnot(all.equal(r1, r2))
      }
    }
  }

  cat(sprintf("%s()...DONE\n", fcn))
} # for (fcn ...)