tests/weightedMean.R

library("matrixStats")

for (mode in c("logical", "integer", "double")) {
  cat("mode: ", mode, "", sep = "")
  n <- 2L
  x <- runif(n, min = -5, max = 5)
  if (mode == "logical") {
    x <- x > 0
  }
  storage.mode(x) <- mode
  str(x)

  cat("All weights are 1\n")
  w <- rep(1, times = n)
  m0 <- weighted.mean(x, w)
  m1 <- weightedMean(x, w)
  str(list(m0 = m0, m1 = m1))
  stopifnot(identical(m1, m0))

  cat("First weight is 5\n")
  # Pull the mean towards zero
  w[1] <- 5
  str(w)
  m0 <- weighted.mean(x, w)
  m1 <- weightedMean(x, w)
  str(list(m0 = m0, m1 = m1))
  stopifnot(identical(m1, m0))

  cat("All weights are 0\n")
  # All weights set to zero
  w <- rep(0, times = n)
  m0 <- weighted.mean(x, w)
  m1 <- weightedMean(x, w)
  str(list(m0 = m0, m1 = m1))
  stopifnot(identical(m1, m0))

  cat("First weight is 8.5\n")
  # Put even more weight on the zero
  w[1] <- 8.5
  m0 <- weighted.mean(x, w)
  m1 <- weightedMean(x, w)
  str(list(m0 = m0, m1 = m1))
  stopifnot(identical(m1, m0))

  cat("First weight is Inf\n")
  # All weight on the first value
  w[1] <- Inf
  m0 <- weighted.mean(x, w)
  m1 <- weightedMean(x, w)
  str(list(m0 = m0, m1 = m1))
  stopifnot(identical(m1, m0))

  cat("Last weight is Inf\n")
  # All weight on the last value
  w[1] <- 1
  w[n] <- Inf
  m0 <- weighted.mean(x, w)
  m1 <- weightedMean(x, w)
  str(list(m0 = m0, m1 = m1))
  stopifnot(identical(m1, m0))
} # for (mode ...)


message("*** Testing for missing values")
# NA tests
xs <- list(A = c(1, 2, 3), B = c(NA, 2, 3), C = c(NA, 2, 3))
ws <- list(A = c(1, 1, 1), B = c(NA, 1, 1), C = c(1, NA, 1))
## NOTE: The (B, B) case with na.rm = TRUE is interesting because
## even if NAs in 'w' are not dropped by na.rm = TRUE, this one
## is because 'x' is dropped and therefore that first element
## is skipped in the computation.  It basically does
##   keep <- !is.na(x); x <- x[keep]; w <- w[keep]
## without looking at 'w'.
for (x in xs) {
  for (mode in c("logical", "integer", "double")) {
    storage.mode(x) <- mode
    for (w in ws) {
      for (na.rm in c(FALSE, TRUE)) {
        cat(sprintf("mode: %s, na.rm = %s\n", mode, na.rm))
        str(list(x = x, w = w))
        m0 <- weighted.mean(x, w, na.rm = na.rm)
        m1 <- weightedMean(x, w, na.rm = na.rm)
        str(list(m0 = m0, m1 = m1))
        stopifnot(all.equal(m1, m0))
      }
    }
  }
}
HenrikBengtsson/matrixStats documentation built on April 12, 2024, 5:32 a.m.