tests/testthat/test-gfpca_twoStep.R

In julia-wrobel/registr: Curve Registration for Exponential Family Functional Data

context("gfpca_twoStep")

test_that("coarsen_index only accepts positive integer 'significant_digits'",{
	index_values = 1:3
	
	expect_that(coarsen_index(index_values, significant_digits = 0),
							throws_error("'significant_digits' must be a positive integer."))
})

test_that("coarsen_index correctly rounds positive values",{
	index_values1 = c(0.84729, 0.9379, 0.19328)
	index_values2 = c(307, 86938, 13)
	
	expect_equal(coarsen_index(index_values1, significant_digits = 1),
							 expected = c(0.8, 0.9, 0.2))
	expect_equal(coarsen_index(index_values1, significant_digits = 3),
							 expected = c(0.847, 0.938, 0.193))
	expect_equal(coarsen_index(index_values2, significant_digits = 1),
							 expected = c(0, 90000, 0))
	expect_equal(coarsen_index(index_values2, significant_digits = 4),
							 expected = c(310, 86940, 10))
})

test_that("coarsen_index correctly rounds negative values",{
	index_values1 = c(0.84729, -0.9379, 0.19328)
	index_values2 = c(-307, 86938, -13)
	
	expect_equal(coarsen_index(index_values1, significant_digits = 1),
							 expected = c(0.8, -0.9, 0.2))
	expect_equal(coarsen_index(index_values1, significant_digits = 3),
							 expected = c(0.847, -0.938, 0.193))
	expect_equal(coarsen_index(index_values2, significant_digits = 1),
							 expected = c(0, 90000, 0))
	expect_equal(coarsen_index(index_values2, significant_digits = 4),
							 expected = c(-310, 86940, -10))
})

test_that("cov_hall returns a covariance matrix with correct dimensions",{
	data(growth_incomplete)
	
	index_grid = c(1.25, seq(from = 2, to = 18, by = 1))
	cov_matrix = cov_hall(growth_incomplete, index_evalGrid = index_grid)
	
	expect_identical(class(cov_matrix)[1], expected = "matrix")
	expect_type(cov_matrix, type = "double")
	expect_identical(dim(cov_matrix), expected = rep(length(index_grid), 2))
})

test_that("gfpca_twoStep (Gaussian) output is a list with non-null items and class fpca",{
	Y = simulate_functional_data(seed = 2020)$Y
	Y$value = Y$latent_mean
	
	fpca_object  = gfpca_twoStep(Y, npc = 2)
	fpca_object2 = gfpca_twoStep(Y, npc_criterion = 0.9)
	fpca_object3 = gfpca_twoStep(Y, npc_criterion = c(0.9, 0.02))
	
	expect_equal(class(fpca_object),  "fpca")
	expect_equal(class(fpca_object2), "fpca")
	expect_equal(class(fpca_object3), "fpca")
	expect_equal(fpca_object$family, "gaussian")
	expect_equal(fpca_object2$family, "gaussian")
	expect_equal(fpca_object3$family, "gaussian")
	
	expect_false(any(is.na(fpca_object$t_vec)))
	expect_false(any(is.na(fpca_object2$t_vec)))
	expect_false(any(is.na(fpca_object3$t_vec)))
	expect_false(any(is.na(fpca_object$mu)))
	expect_false(any(is.na(fpca_object2$mu)))
	expect_false(any(is.na(fpca_object3$mu)))
	expect_false(any(is.na(fpca_object$efunctions)))
	expect_false(any(is.na(fpca_object2$efunctions)))
	expect_false(any(is.na(fpca_object3$efunctions)))
	expect_false(any(is.na(fpca_object$evalues)))
	expect_false(any(is.na(fpca_object2$evalues)))
	expect_false(any(is.na(fpca_object3$evalues)))
	expect_false(any(is.na(fpca_object$scores)))
	expect_false(any(is.na(fpca_object2$scores)))
	expect_false(any(is.na(fpca_object3$scores)))
})

test_that("gfpca_twoStep (Gaussian) output has correct number of dimensions",{
	Y = simulate_functional_data(I = 100, D = 200, seed = 2020)$Y
	Kt = 8
	fpca_object  = gfpca_twoStep(Y, npc = 2, Kt = Kt, index_significantDigits = 4)
	fpca_object2 = gfpca_twoStep(Y, npc_criterion = 0.9, Kt = Kt, index_significantDigits = 4)
	
	expect_equal(length(fpca_object$t_vec), 200)
	expect_equal(length(fpca_object2$t_vec), 200)
	expect_equal(dim(fpca_object$alpha), c(200, 1))
	expect_equal(dim(fpca_object2$alpha), c(200, 1))
	expect_equal(dim(fpca_object$efunctions), c(200, 2))
	expect_equal(dim(fpca_object2$efunctions), c(200, 2))
	expect_equal(length(fpca_object$evalues), 2)
	expect_equal(length(fpca_object2$evalues), 2)
	expect_equal(dim(fpca_object$scores), c(length(unique(Y$id)), 2))
	expect_equal(dim(fpca_object2$scores), c(length(unique(Y$id)), 2))
	expect_equal(length(fpca_object$knots), Kt - 4)
	expect_equal(length(fpca_object2$knots), Kt - 4)
	
	fpca_object = gfpca_twoStep(Y, npc = 1, Kt = Kt, index_significantDigits = 4)
	expect_equal(dim(fpca_object$efunctions), c(200, 1))
})

test_that("gfpca_twoStep (Binomial) output has correct number of dimensions",{
	Y = simulate_functional_data(I = 100, D = 200, seed = 2020)$Y
	Kt = 8
	fpca_object = gfpca_twoStep(Y, npc = 2, Kt = Kt, family = "binomial",
															index_significantDigits = 4)
	
	expect_equal(length(fpca_object$t_vec), 200)
	expect_equal(dim(fpca_object$alpha), c(200, 1))
	expect_equal(dim(fpca_object$efunctions), c(200, 2))
	expect_equal(length(fpca_object$evalues), 2)
	expect_equal(dim(fpca_object$scores), c(length(unique(Y$id)), 2))
	expect_equal(length(fpca_object$knots), Kt - 4)
	
	fpca_object = gfpca_twoStep(Y, npc = 1, Kt = Kt, family = "binomial",
															index_significantDigits = 4)
	expect_equal(dim(fpca_object$efunctions), c(200, 1))
})

test_that("gfpca_twoStep (Gamma) output has correct number of dimensions",{
	Y       = simulate_functional_data(I = 100, D = 200, seed = 2020)$Y
	Y$value = Y$value + 1 # make data strictly positive for gamma family
	Kt      = 8
	fpca_object = gfpca_twoStep(Y, npc = 2, Kt = Kt, family = "gamma",
															index_significantDigits = 2)
	
	expect_equal(length(fpca_object$t_vec), 11)
	expect_equal(dim(fpca_object$alpha), c(11, 1))
	expect_equal(dim(fpca_object$efunctions), c(11, 2))
	expect_equal(length(fpca_object$evalues), 2)
	expect_equal(dim(fpca_object$scores), c(length(unique(Y$id)), 2))
	expect_equal(length(fpca_object$knots), Kt - 4)
	
	fpca_object = gfpca_twoStep(Y, npc = 1, Kt = Kt, family = "gamma",
															index_significantDigits = 2)
	expect_equal(dim(fpca_object$efunctions), c(11, 1))
})

test_that("gfpca_twoStep (Poisson) output has correct number of dimensions",{
	Y       = simulate_functional_data(I = 100, D = 200, seed = 2020)$Y
	Y$value = Y$value + 1 # make data strictly positive for poisson family
	Kt      = 8
	fpca_object = gfpca_twoStep(Y, npc = 2, Kt = Kt, family = "poisson",
															index_significantDigits = 2)
	
	expect_equal(length(fpca_object$t_vec), 11)
	expect_equal(dim(fpca_object$alpha), c(11, 1))
	expect_equal(dim(fpca_object$efunctions), c(11, 2))
	expect_equal(length(fpca_object$evalues), 2)
	expect_equal(dim(fpca_object$scores), c(length(unique(Y$id)), 2))
	expect_equal(length(fpca_object$knots), Kt - 4)
	
	fpca_object = gfpca_twoStep(Y, npc = 1, Kt = Kt, family = "poisson",
															index_significantDigits = 2)
	expect_equal(dim(fpca_object$efunctions), c(11, 1))
})


test_that("gfpca_twoStep (Gaussian) returns a correct knots vector when periodic = TRUE",{
	Y = simulate_functional_data(I = 100, D = 200, seed = 2020)$Y
	Kt = 8
	fpca_object = gfpca_twoStep(Y, npc = 2, Kt = Kt, periodic = TRUE, index_significantDigits = 2)
	
	expect_equal(length(fpca_object$knots), Kt - 1)
})

test_that("gfpca_twoStep (Gaussian) has correct number of dimensions when applied on incomplete curves",{
	Y = registr::growth_incomplete
	Kt = 8
	fpca_object = gfpca_twoStep(Y, npc = 2, Kt = Kt, index_significantDigits = 4)
	
	expect_equal(length(fpca_object$t_vec), 30)
	expect_equal(dim(fpca_object$alpha), c(30, 1))
	expect_equal(dim(fpca_object$efunctions), c(30, 2))
	expect_equal(length(fpca_object$evalues), 2)
	expect_equal(dim(fpca_object$scores), c(length(unique(Y$id)), 2))
	expect_equal(length(fpca_object$knots), Kt - 4)
	
	fpca_object = gfpca_twoStep(Y, npc = 1, Kt = Kt, index_significantDigits = 4)
	expect_equal(dim(fpca_object$efunctions), c(30, 1))
})

test_that("gfpca_twoStep (Gamma) throws an error when applied to non-strictly positive data",{
	Y = registr::growth_incomplete
	
	expect_error(gfpca_twoStep(Y, family = "gamma"),
							 "family = 'gamma' can only be applied to strictly positive data.")
})

test_that("gfpca_twoStep (Poisson) throws an error when applied to negative data",{
	Y = registr::growth_incomplete
	
	expect_error(gfpca_twoStep(Y, family = "poisson"),
							 "family = 'poisson' can only be applied to nonnegative data.")
})

test_that("crossprods_regular and crossprods_irregular work as expected",{
  data(growth_incomplete)
  
  dat = growth_incomplete %>% mutate(centered = value - mean(value))
  
  cp1 = crossprods_regular(dat)
  cp2 = crossprods_irregular(dat)
  
  expect_equal(ncol(cp1), 4)
  expect_equal(ncol(cp2), 4)
  expect_true(all(!is.na(cp1$cross)))
  expect_true(all(!is.na(cp2$cross)))
})

test_that("Helper function 'determine_npc()' works as expected",{
  evalues = c(15,2,seq(0.5, 0.1, length.out = 20),0.0001,0)
  
  npc_criterion1 = 0.9
  expect_equal(determine_npc(evalues, npc_criterion1), 11)
  
  npc_criterion2 = c(0.9, 0.02)
  expect_equal(determine_npc(evalues, npc_criterion2), 4)
})