tests/testthat/test-0_util.R

In spinifex: Manual Tours, Manual Control of Dynamic Projections of Numeric Multivariate Data

{
  library("spinifex")
  library("testthat")
  r_idx <- c(1:3, (nrow(wine) - 2):nrow(wine))
  sub  <- wine[r_idx, ]
  dat  <- scale_sd(sub[, 2:6])
  clas <- sub$Type
  bas  <- basis_pca(dat)
  mv   <- manip_var_of(bas)
}

##
## MATH AND TRANSFORMS -----
##

rb <- tourr::basis_random(ncol(dat), 2)
ib <- tourr::basis_init(n = 4, 2)
b_pca    <- basis_pca(dat)
b_guide  <- basis_guided(data = dat, index_f = tourr::holes())
diag4    <- diag(4)
not_orth <- matrix(sample(1:16, 16), ncol=4)

### is_orthonormal -----
test_that("is_orthonormal: bases functions & diag() are orthonormal, rand matrix isn't", {
  expect_true(is_orthonormal(rb))
  expect_true(is_orthonormal(ib))
  expect_true(is_orthonormal(b_pca))
  expect_true(is_orthonormal(b_guide))
  expect_true(is_orthonormal(diag4))
  expect_false(is_orthonormal(not_orth))
})

ret_t <- is_orthonormal(rb)
ret_f <- is_orthonormal(not_orth)
test_that("is_orthonormal: returns are logical.", {
  expect_equal(class(ret_t), "logical")
  expect_equal(class(ret_f), "logical")
})

### array2df -----

## Array with a single frame, as used in view_frame()
array_single <- array(bas, dim = c(dim(bas), 1))
attr(array_single, "manip_var") <- mv
ret_single <- array2df(basis_array = array_single)

## Radial tour array to long df, as used in play_manual_tour()
mt_array <- manual_tour(basis = bas, manip_var = mv)
ret_mt <- array2df(basis_array = mt_array, data = dat,
                       basis_label = paste0("MyLabs", 1:nrow(bas)),
                       data_label = paste0("obs# ", 1:nrow(dat)))


## tourr::save_history tour array to long df, as used in play_tour_path()
gt_array <- save_history(data = dat, max_bases = 10)
class(gt_array) <- "array"
ret_gt <- array2df(basis_array = gt_array, data = dat,
                   basis_label = paste0("MyLabs", 1:nrow(bas)),
                   data_label = paste0("obs# ", 1:nrow(dat)))

test_that("array2df: class", {
  expect_equal(class(ret_single), "list")
  expect_equal(class(ret_mt    ), "list")
  expect_equal(class(ret_gt    ), "list")
})
test_that("array2df: length", {
  expect_equal(length(ret_single), 1)
  expect_equal(length(ret_mt)    , 2)
  expect_equal(length(ret_gt)    , 2)
})


### map_relative ------
ret    <- map_relative(x = bas, position = "bottomleft")
ret_to <- map_relative(x = bas, position = "topright", to = wine[, 2:3])

test_that("map_relative: class and dim", {
  expect_equal(class(ret   ), c("matrix" ,"array"))
  expect_equal(class(ret_to), c("matrix" ,"array"))
  expect_equal(dim(ret), c(5, 2))
  expect_equal(dim(ret_to), c(5, 2))
})


### map_absolute -----
ret_mat   <- map_absolute(x = bas, offset = c(-1, 0), scale = c(2/3, 2/3))
ret_df    <- map_absolute(x = mtcars[,1:2], offset = c(0, 100), scale = c(.1, .1))

test_that("map_absolute: class and dim", {
  expect_equal(class(ret_mat), c("matrix" ,"array"))
  expect_equal(class(ret_df ),  "data.frame")
  expect_equal(dim(ret_mat), c(5, 2))
  expect_equal(dim(ret_df),  c(32, 2))
})

##
## GGPLOT2 AESTHETICS ------
##

### theme_spinifex ----

t <- theme_spinifex()
g <- ggplot2::ggplot() + t
test_that("theme_spinifex: class", {
  expect_equal(class(t), "list")
  expect_equal(class(g), c("gg", "ggplot"))
})

##
## BASIS AND MANIP VAR HELPERS -----
##

### basis_* -----
b1 <- basis_pca(dat)
b2 <- basis_half_circle(dat)
b3 <- basis_odp(dat, clas)
b4 <- basis_olda(wine[, 2:6], wine$Type)

test_that("basis_*", {
  expect_equal(class(b1), c("matrix", "array"))
  expect_equal(class(b2), c("matrix", "array"))
  expect_equal(class(b3), c("matrix", "array"))
  expect_equal(class(b4), c("matrix", "array"))
  expect_equal(dim(b1), c(5, 2))
  expect_equal(dim(b2), c(5, 2))
  expect_equal(dim(b3), c(5, 2))
  expect_equal(dim(b4), c(5, 2))
  expect_equal(is_orthonormal(b1), TRUE)
  expect_equal(is_orthonormal(b2), TRUE)
  expect_equal(is_orthonormal(b3), TRUE)
  expect_equal(is_orthonormal(b4), TRUE)
})

## no roi for a unit test of basis_pca()


### basis_guided -----

ret_holes <- basis_guided(data = dat, index_f = tourr::holes())
ret_cmass <- basis_guided(data = dat, index_f = tourr::cmass(),
                          alpha = .4, cooling = .9, max.tries = 30)

test_that("basis_guided: class and dim", {
  expect_equal(class(ret_holes), c("matrix", "array"))
  expect_equal(class(ret_cmass), c("matrix", "array"))
  expect_equal(dim(ret_holes), c(5, 2))
  expect_equal(dim(ret_cmass), c(5, 2))
  expect_equal(is_orthonormal(ret_holes), TRUE)
  expect_equal(is_orthonormal(ret_cmass), TRUE)
})



### manip_var_of ------
ret <- manip_var_of(bas)
test_that("manip_var_of: class and dim", {
  expect_equal(class(ret), "integer")
  expect_equal(length(ret), 1)
  expect_warning(manip_var_of(not_orth))
})

## scale functions ----
s1 <- scale_sd(mtcars)
s2 <- scale_01(dat)
s3 <- scale_01(as.matrix(mtcars))

test_that("scale, class, bounds, dim", {
  expect_equal(class(s1), c("matrix", "array")) ## coerced to matrix.
  expect_equal(class(s2), c("matrix", "array"))
  expect_equal(class(s3), c("matrix", "array"))
  # expect_equal(min(s1), 0)
  # expect_equal(max(s1), 1)
  expect_equal(min(s2), 0)
  expect_equal(max(s2), 1)
  expect_equal(min(s3), 0)
  expect_equal(max(s3), 1)
  expect_equal(dim(s1), dim(mtcars))
  expect_equal(dim(s2), dim(dat))
  expect_equal(dim(s3), dim(mtcars))
})

##
## DEPRICATED:  -----
##

test_that("other basis_* class, orth, ", {
  expect_warning(sa <- scale_axes(mtcars))
  expect_equal(sa, map_relative(mtcars))
  expect_warning(pz <- pan_zoom(mtcars))
  expect_equal(pz, map_absolute(mtcars))
})