tests/testthat/test-fpca_gauss.R

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

context("fpca_gauss")

test_that("fpca_gauss 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  = fpca_gauss(Y, npc = 2)
	expect_warning({
	  fpca_object2 = fpca_gauss(Y, npc_varExplained = 0.9, maxiter = 2)
	}, "fpca_gauss convergence not reached. Try increasing maxiter.")
	
	expect_equal(class(fpca_object),  "fpca")
	expect_equal(class(fpca_object2), "fpca")
	expect_equal(fpca_object$family,  "gaussian")
	expect_equal(fpca_object2$family, "gaussian")
	
	expect_false(any(is.na(fpca_object$mu)))
	expect_false(any(is.na(fpca_object2$mu)))
	expect_false(any(is.na(fpca_object$efunctions)))
	expect_false(any(is.na(fpca_object2$efunctions)))
	expect_false(any(is.na(fpca_object$evalues)))
	expect_false(any(is.na(fpca_object2$evalues)))
	expect_false(any(is.na(fpca_object$scores)))
	expect_false(any(is.na(fpca_object2$scores)))
})

test_that("fpca_gauss output has correct number of dimensions",{
	Y = simulate_functional_data(I = 100, D = 200, seed = 2020)$Y
	Kt = 8
	expect_warning({
	  fpca_object  = fpca_gauss(Y, npc = 2, Kt = Kt)
	}, "fpca_gauss convergence not reached. Try increasing maxiter.")
	expect_warning({
	  fpca_object2 = fpca_gauss(Y, npc_varExplained = 0.9, maxiter = 2)
	}, "fpca_gauss convergence not reached. Try increasing maxiter.")
	
	expect_equal(dim(fpca_object$alpha),  c(100, 1))
	expect_equal(dim(fpca_object2$alpha), c(100, 1))
	expect_equal(dim(fpca_object$efunctions),  c(100, 2))
	expect_equal(dim(fpca_object2$efunctions), c(100, 2))
	expect_equal(length(fpca_object$evalues),  2)
	expect_equal(length(fpca_object2$evalues), 2)
	expect_equal(dim(fpca_object$scores),  c(100, 2))
	expect_equal(dim(fpca_object2$scores), c(100, 2))
	expect_equal(length(fpca_object$knots),  Kt - 4)
	expect_equal(length(fpca_object2$knots), 20 - 4)
	
	expect_warning({
	  fpca_object = fpca_gauss(Y, npc = 1, Kt = Kt)
	}, "fpca_gauss convergence not reached. Try increasing maxiter.")
	expect_equal(dim(fpca_object$efunctions), c(100, 1))
})

test_that("fpca_gauss output has correct number of dimensions when periodic = TRUE",{
	Y = simulate_functional_data(I = 100, D = 200, seed = 2020)$Y
	Kt = 8
	expect_warning({
	  fpca_object = fpca_gauss(Y, npc = 2, Kt = Kt, periodic = TRUE)
	}, "fpca_gauss convergence not reached. Try increasing maxiter.")
	
	expect_equal(dim(fpca_object$alpha), c(100, 1))
	expect_equal(dim(fpca_object$efunctions), c(100, 2))
	expect_equal(length(fpca_object$evalues), 2)
	expect_equal(dim(fpca_object$scores), c(100, 2))
	expect_equal(length(fpca_object$knots), Kt - 1)
	
	expect_warning({
	  fpca_object = fpca_gauss(Y, npc = 1, Kt = Kt, periodic = TRUE)
	}, "fpca_gauss convergence not reached. Try increasing maxiter.")
	expect_equal(dim(fpca_object$efunctions), c(100, 1))
})

test_that("fpca_gauss has correct number of dimensions when applied on incomplete curves",{
	Y = registr::growth_incomplete
	Kt = 8
	expect_warning({
	  fpca_object = fpca_gauss(Y, npc = 2, Kt = Kt)
	}, "fpca_gauss convergence not reached. Try increasing maxiter.")
	
	expect_equal(dim(fpca_object$alpha), c(100, 1))
	expect_equal(dim(fpca_object$efunctions), c(100, 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)
	
	expect_warning({
	  fpca_object = fpca_gauss(Y, npc = 1, Kt = Kt)
	}, "fpca_gauss convergence not reached. Try increasing maxiter.")
	expect_equal(dim(fpca_object$efunctions), c(100, 1))
})