context("Utility functions") test_that("By", { b1 <- By(datasets::CO2,~Treatment+Type,colMeans,~conc) b2 <- By(datasets::CO2,c('Treatment','Type'),colMeans,'conc') testthat::expect_equivalent(b1,b2) ## require('data.table') ## t1 <- as.data.frame(data.table(datasets::CO2)[,mean(uptake),by=.(Treatment,Type,conc>500)]) d0 <- transform(datasets::CO2,conc500=conc>500) t1 <- by(d0[,"uptake"],d0[,c("Treatment","Type","conc500")],mean) t2 <- By(datasets::CO2,~Treatment+Type+I(conc>500),colMeans,~uptake) testthat::expect_true(inherits(t2,"array")) testthat::expect_equivalent(sort(t2),sort(t1)) }) test_that("Expand", { dd <- Expand(iris, Sepal.Length=2:8, Species=c("virginica","setosa")) testthat::expect_identical(levels(iris$Species),levels(dd$Species)) testthat::expect_true(nrow(dd)==14) d0 <- datasets::warpbreaks[,c("wool","tension")] T <- table(d0) d1 <- Expand(T) testthat::expect_identical(dim(d0),dim(d1)) testthat::expect_identical(table(d1),T) testthat::expect_identical(expand.grid(1:2,1:2),Expand(1:2,1:2)) testthat::expect_identical(expand.grid(a=1:2,b=1:2),Expand(a=1:2,b=1:2)) }) test_that("formulas", { f <- toformula(c('y1','y2'),'x'%++%1:5) ff <- getoutcome(f) testthat::expect_equivalent(trim(ff,all=TRUE),"c(y1,y2)") testthat::expect_true(length(attr(ff,'x'))==5) }) test_that("trim", { testthat::expect_true(length(grep(" ",trim(" test ")))==0) testthat::expect_true(length(gregexpr(" ",trim(" t e s t "))[[1]])==3) testthat::expect_true(length(grep(" ",trim(" t e s t ",all=TRUE)))==0) }) test_that("Matrix operations:", { ## vec operator testthat::expect_equivalent(vec(diag(3)),c(1,0,0,0,1,0,0,0,1)) testthat::expect_true(nrow(vec(diag(3),matrix=TRUE))==9) ## commutaion matrix A <- matrix(1:16 ,ncol=4) K <- commutation(A) testthat::expect_equivalent(K%*%as.vector(A),vec(t(A),matrix=TRUE)) ## Block diagonal A <- diag(3)+1 B <- blockdiag(A,A,A,pad=NA) testthat::expect_equivalent(dim(B),c(9,9)) testthat::expect_true(sum(is.na(B))==81-27) }) test_that("wrapvev", { testthat::expect_equivalent(wrapvec(5,2),c(3,4,5,1,2)) testthat::expect_equivalent(wrapvec(seq(1:5),-1),c(5,1,2,3,4)) }) test_that("matrix functions", { A <- revdiag(1:3) testthat::expect_equivalent(A,matrix(c(0,0,1,0,2,0,3,0,0),3)) testthat::expect_equivalent(1:3,revdiag(A)) revdiag(A) <- 4 testthat::expect_equivalent(rep(4,3),revdiag(A)) diag(A) <- 0 offdiag(A) <- 5 testthat::expect_true(sum(offdiag(A))==6*5) A <- matrix(0,3,3) offdiag(A,type=3) <- 1:6 B <- crossprod(A) testthat::expect_equivalent(solve(A),Inverse(A)) testthat::expect_equivalent(det(B),attr(Inverse(B,chol=TRUE),"det")) }) test_that("All the rest", { testthat::expect_false(lava:::versioncheck(NULL)) testthat::expect_true(lava:::versioncheck("lava",c(1,4,1))) op <- lava.options(debug=TRUE) testthat::expect_true(lava.options()$debug) lava.options(op) A <- diag(2); colnames(A) <- c("a","b") testthat::expect_output(printmany(A,A,2,rownames=c("A","B"),bothrows=FALSE),"a b") testthat::expect_output(printmany(A,A[1,,drop=FALSE],2,rownames=c("A","B"),bothrows=FALSE),"a b") testthat::expect_output(printmany(A,A,2,rownames=c("A","B"),name1="no.1",name2="no.2", bothrows=TRUE),"no.1") ##printmany(A,A,2,name1="no.1",name2="no.2",bothrows=T) })