R Under development (unstable) (2023-12-09 r85665 ucrt) -- "Unsuffered Consequences" Copyright (C) 2023 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > 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) + } + } > > proc.time() user system elapsed 0.18 0.04 0.23