tests/binMeans,binCounts_subset.R

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

library("matrixStats")

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Naive R implementation of binMeans()
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
binMeans0 <- function(y, x, bx, na.rm = TRUE, count = TRUE, right = FALSE) {
  n_smooth <- length(bx) - 1L
  res <- double(n_smooth)
  counts <- rep(NaN, times = n_smooth)

  if (na.rm) {
    keep <- !is.na(x) & !is.na(y)
    x <- x[keep]
    y <- y[keep]
  }

  # For each bin...
  for (kk in seq_len(n_smooth)) {
    if (right) {
      idxs <- which(bx[kk] <  x & x <= bx[kk + 1L])
    } else {
      idxs <- which(bx[kk] <= x & x <  bx[kk + 1L])
    }
    y_kk <- y[idxs]
    res[kk] <- mean(y_kk)
    counts[kk] <- length(idxs)
  } # for (kk ...)

  if (count) attr(res, "count") <- counts
  res
}


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Subsetted tests
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
source("utils/validateIndicesFramework.R")
y <- runif(6, min = -6, max = 6)
x <- runif(6, min = -6, max = 6)
storage.mode(x) <- "integer"
bx <- c(-6, 0, 3, 4, 10)
for (idxs in index_cases) {
  for (na.rm in c(TRUE, FALSE)) {
    validateIndicesTestVector_w(y, x, idxs,
                                ftest = binMeans, fsure = binMeans0,
                                bx = bx, na.rm = na.rm,
                                count = TRUE, right = FALSE)
    validateIndicesTestVector_w(y, x, idxs,
                                ftest = binMeans, fsure = binMeans0,
                                bx = bx, na.rm = na.rm,
                                count = TRUE, right = TRUE)
  }
}