# Helper functions test_that("head_list(x) = head(x) for matrix x", { x <- cbind(1:10, 2:11) expect_equal(head_list(x), utils::head(x)) }) test_that("head_list(x)[[1L]] = head(x[[1L]]) for list of matries x", { x1 <- cbind(1:10, 2:11) x2 <- cbind(1:7, 2:8) x <- list(x1, x2) expect_equal(head_list(x)[[1L]], utils::head(x[[1L]])) }) test_that("reorganize_list() fails for non-list inputs", { expect_error(reorganize_list(alist = 1:10)) }) test_that("wcolMeans() gives the same as colMeans() in unweighted case", { X <- cbind(1:3, 2:4) expect_equal(c(wcolMeans(X)), colMeans(X)) expect_equal(c(wcolMeans(X, w = c(1, 1, 1))), colMeans(X)) expect_equal(c(wcolMeans(X, w = c(2, 2, 2))), colMeans(X)) }) test_that("exact_Z() works for both kernel- and permshap", { p <- 5 nm <- LETTERS[1:p] r1 <- exact_Z(p, feature_names = nm, keep_extremes = TRUE) r2 <- exact_Z(p, feature_names = nm, keep_extremes = FALSE) expect_equal(r1[2:(nrow(r1) - 1L), ], r2) expect_equal(colnames(r1), nm) expect_equal(dim(r1), c(2^p, p)) }) test_that("rep_rows() gives the same as usual subsetting (except rownames)", { setrn <- function(x) {rownames(x) <- 1:nrow(x); x} expect_equal(rep_rows(iris, 1), iris[1, ]) expect_equal(rep_rows(iris, 2:1), setrn(iris[2:1, ])) expect_equal(rep_rows(iris, c(1, 1, 1)), setrn(iris[c(1, 1, 1), ])) ir <- iris[1, ] ir$y <- list(list(a = 1, b = 2)) expect_equal(rep_rows(ir, c(1, 1)), setrn(ir[c(1, 1), ])) }) test_that("rep_rows() gives the same as usual subsetting for matrices", { ir <- data.matrix(iris[1:4]) expect_equal(rep_rows(ir, c(1, 1, 2)), ir[c(1, 1, 2), ]) expect_equal(rep_rows(ir, 1), ir[1, , drop = FALSE]) }) # Unit tests copied from {hstats} test_that("rep_each() works", { expect_equal(rep_each(3, 10), rep_each(3L, 10L)) expect_equal(rep_each(3, 10), rep(1:3, each = 10)) expect_true(is.integer(rep_each(100, 100))) }) test_that("wrowmean_vector() works for 1D matrices", { x2 <- cbind(a = 6:1) out2 <- wrowmean_vector(x2, ngroups = 2L) expec <- rowsum(x2, group = rep(1:2, each = 3)) / 3 rownames(expec) <- NULL expect_error(wrowmean_vector(matrix(1:4, ncol = 2L))) expect_equal(out2, expec) expect_equal(wrowmean_vector(x2, ngroups = 3L), cbind(a = c(5.5, 3.5, 1.5))) # Constant weights have no effect expect_equal(wrowmean_vector(x2, ngroups = 2L, w = c(1, 1, 1)), out2) expect_equal(wrowmean_vector(x2, ngroups = 2L, w = c(4, 4, 4)), out2) # Non-constant weights a <- weighted.mean(6:4, 1:3) b <- weighted.mean(3:1, 1:3) out2 <- wrowmean_vector(x2, ngroups = 2L, w = 1:3) expect_equal(out2, cbind(a = c(a, b))) }) test_that("align_pred() works", { expect_error(align_pred(c("A", "B"))) expect_error(align_pred(factor(c("A", "B")))) expect_equal(align_pred(1:4), as.matrix(1:4)) })