tests/testthat/test_preprocess.R

In multivarious: Extensible Data Structures for Multivariate Analysis

context("pre-processing")
library(magrittr)
library(testthat)

test_that("can preprocess a matrix no center, no scale", {
  mat1 <- matrix(rnorm(10*15), 10, 15)
  pp <- pass() %>% prep()
  X <- pp$init(mat1)
  x2 <- pp$reverse_transform(X)
  expect_equal(mat1,x2)
  expect_equal(X, mat1)
})

test_that("can preprocess a matrix center only", {
  mat1 <- matrix(rnorm(10*15), 10, 15)
  pp <- center() %>% prep()
  Xp <- pp$init(mat1)
  x2 <- pp$reverse_transform(Xp)
  expect_equal(mat1,x2)
  expect_true(all(mat1 != Xp))
})

test_that("can apply a centering transform", {
  mat1 <- matrix(rnorm(10*15), 10, 15)
  pp <- center()
  x <- prep(pp)
  x2 <- init_transform(x,mat1)
  x3 <- apply_transform(x,mat1)
  expect_equal(x2,x3)
})

test_that("can apply a scaling transform", {
  mat1 <- matrix(rnorm(10*15), 10, 15)
  pp <- standardize()
  x <- prep(pp)
  x2 <- init_transform(x, mat1)
  x3 <- apply_transform(x, mat1)
  expect_equal(x2,x3)
 
})

test_that("can preprocess a matrix with column scaling", {
  mat1 <- matrix(rnorm(10*15), 10, 15)
  wts <- 2:16
  pp <- colscale(type="weights", weights=wts)
  x <- prep(pp)
  xinit <- init_transform(x, mat1)
  xrev <- reverse_transform(x, xinit)
  expect_equal(mat1,xrev)
})

# test_that("can reset a prepper with `fresh`", {
#   mat1 <- matrix(rnorm(10*15), 10, 15)
#   pp <- center()
#   x <- prep(pp, mat1)
#   
# })



test_that("can reverse transform a matrix after standardization", {
  mat1 <- matrix(rnorm(10*15), 10, 15)
  pp <- standardize()
  x <- prep(pp)
  x1 <- init_transform(x,mat1)
  x2 <- reverse_transform(x, x1)
  expect_equal(mat1,x2)
})



test_that("can compose two pre-processors", {
  mat1 <- matrix(rnorm(10*15), 10, 15)
  x <- center() %>% colscale(type="z") %>% prep()
  
  x1 <- init_transform(x,mat1)
  x2 <- reverse_transform(x, x1)
  expect_equal(mat1,x2)

})



test_that("can preprocess a matrix with a colind", {
  mat1 <- matrix(rnorm(10*15), 10, 15)
  pp <- center() %>% prep()
  
  x <- init_transform(pp,mat1)
  ret <- apply_transform(pp, mat1[,1:2], colind=1:2)
  
  expect_equal(ret, x[,1:2])
})

test_that("can concatenate two pre-processors", {
  mat1 <- matrix(rnorm(10*15), 10, 15)
  mat2 <- matrix(rnorm(10*15), 10, 15)
  p <- center()
  
  proclist <- lapply(1:2, function(i) {
    fresh(p) %>% prep()
  })
  
  m1 <- init_transform(proclist[[1]], mat1)
  m2 <- init_transform(proclist[[2]], mat2)
  proc <- concat_pre_processors(proclist, list(1:15, 16:30))
  
  a1 <- apply_transform(proc, cbind(mat1,mat2))
  a2 <- apply_transform(proc, mat1, colind=1:15)
  a3 <- apply_transform(proc, mat2, colind=16:30)
  
  pres<- pca(cbind(mat1,mat2), ncomp=12)
  proj <- multiblock_biprojector(pres$v, s=pres$s, sdev=pres$sdev, proc, block_indices=list(1:15, 16:30))
  p1 <- project_block(proj, m1, 1)
  p2 <- project_block(proj, m2, 2)
  
  expect_true(!is.null(p1))
  expect_true(!is.null(p2))
  
  proc$transform(mat1, colind=1:15)
  proc$transform(mat2, colind=16:30)
  
  proj <- multiblock_projector(pres$v, proc, block_indices=list(1:15, 16:30))
  p1 <- project_block(proj, m1, 1)
  p2 <- project_block(proj, m2, 2)
  
  expect_true(!is.null(p1))
  expect_true(!is.null(p2))
  
})


# 
# test_that("can preprocess a block projector", {
#   mat1 <- matrix(rnorm(10*15), 10, 15)
#   mat2 <-  matrix(rnorm(10*10), 10, 10)
#   pca1 <- pca(mat1, ncomp=4)
#   pca2 <- pca(mat2, ncomp=2)
#   
#   bm <- block_projector(list(pca1,pca2))
#   pp <- pre_processor(bm,center=FALSE, scale=FALSE)
#   pdat <- pre_process(pp)
#   expect_equal(ncol(pdat), 6)
#   expect_equal(project(bm), pdat)
# })
# 
# test_that("can preprocess a block projector with newdata", {
#   mat1 <- matrix(rnorm(10*15), 10, 15)
#   mat2 <-  matrix(rnorm(10*10), 10, 10)
#   pca1 <- pca(mat1, ncomp=4)
#   pca2 <- pca(mat2, ncomp=2)
#   
#   bm <- block_projector(list(pca1,pca2))
#   pp <- pre_processor(bm,center=FALSE, scale=FALSE)
#   
#   mat3 <- cbind(mat1,mat2)
#   pdat <- pre_process(pp,mat3)
#   
#   expect_equal(ncol(pdat), 6)
#   expect_equal(project(bm), pdat)
# })
# 
# test_that("can preprocess a block projector with newdata from a sub-block", {
#   mat1 <- matrix(rnorm(10*15), 10, 15)
#   mat2 <-  matrix(rnorm(10*10), 10, 10)
#   pca1 <- pca(mat1, ncomp=4)
#   pca2 <- pca(mat2, ncomp=2)
#   
#   bm <- block_projector(list(pca1,pca2))
#   pp <- pre_processor(bm,center=FALSE, scale=FALSE)
#   
#   mat3 <- cbind(mat2)
#   pdat <- pre_process(pp,mat3, block_index=2)
#   
#   expect_equivalent(project(bm, block_index=2), unclass(pdat))
# })