# tests/testthat/testmixsim.R In MixMatrix: Classification with Matrix Variate Normal and t Distributions

library(MixMatrix)

context("Testing matrixmixture")

set.seed(20180221)
a_mat <- rmatrixnorm(15, mean = matrix(0, nrow = 3, ncol = 4))
b_mat <- rmatrixnorm(15, mean = matrix(2, nrow = 3, ncol = 4))
c_mat <- array(c(a_mat, b_mat), dim = c(3, 4, 30))
prior <- c(.5, .5)
init <- list(
centers = array(c(rep(0, 12), rep(2, 12)), dim = c(3, 4, 2)),
U = array(c(diag(3), diag(3)), dim = c(3, 3, 2)),
V = array(c(diag(4), diag(4)), dim = c(4, 4, 2))
)
expect_error(matrixmixture(c_mat, init, prior = c(.1, .1)))
expect_error(matrixmixture(c_mat, init, prior = 0))
expect_error(matrixmixture(c_mat, init, prior = c(5, .1)))
expect_error(matrixmixture(c_mat, init, prior = c(-1, .1)))
expect_error(matrixmixture(c_mat, init))
expect_error(matrixmixture(list(),
prior = c(.5, .5),
model = "t", nu = 10
))
expect_error(matrixmixture(numeric(0),
prior = c(.5, .5),
model = "t", nu = 10
))
})

test_that("Bad results warn or stop", {
set.seed(20180221)
a_mat <- rmatrixnorm(15, mean = matrix(0, nrow = 3, ncol = 4))
b_mat <- rmatrixnorm(15, mean = matrix(2, nrow = 3, ncol = 4))
c_mat <- array(c(a_mat, b_mat), dim = c(3, 4, 30))
prior <- c(.5, .5)
init <- list(
centers = array(c(rep(0, 12), rep(2, 12)), dim = c(3, 4, 2)),
U = array(c(diag(3), diag(3)), dim = c(3, 3, 2)),
V = array(c(diag(4), diag(4)), dim = c(4, 4, 2))
)
expect_warning(capture.output(matrixmixture(c_mat, init,
prior = c(.5, .5),
iter = 1, verbose = 100
),
type = "output"
))
expect_warning(matrixmixture(c_mat, init,
prior = 2,
model = "t", nu = 10, iter = 1
))
expect_warning(matrixmixture(c_mat,
K = 2, model = "t",
nu = 10, iter = 1
))
})

test_that("Mean restrictions work", {
test_allequal <- function(x) all(abs(c(x) - c(x)[1]) < 1e-6)

set.seed(20180221)
a_mat <- rmatrixnorm(15, mean = matrix(0, nrow = 3, ncol = 4))
b_mat <- rmatrixnorm(15, mean = matrix(1, nrow = 3, ncol = 4))
c_mat <- array(c(a_mat, b_mat), dim = c(3, 4, 30))
prior <- c(.5, .5)

expect_true(test_allequal(c(matrixmixture(c_mat,
prior = c(.5, .5),
col.mean = TRUE,
row.mean = TRUE
)\$centers[, , 1])))
expect_true(test_allequal(c(matrixmixture(c_mat,
prior = c(.5, .5),
col.mean = FALSE,
row.mean = TRUE
)\$centers[1, , 1])))
expect_true(test_allequal(matrixmixture(c_mat,
prior = c(.5, .5),
col.mean = TRUE,
row.mean = FALSE
)\$centers[, 1, 1]))
expect_true(!test_allequal(matrixmixture(c_mat,
prior = c(.5, .5),
col.mean = FALSE,
row.mean = FALSE
)\$centers[1, , 1]))

expect_true(test_allequal(matrixmixture(c_mat,
prior = c(.5, .5), col.mean = TRUE,
row.mean = TRUE, model = "t", nu = 5
)\$centers[, , 1]))
expect_true(test_allequal(matrixmixture(c_mat,
prior = c(.5, .5), col.mean = FALSE,
row.mean = TRUE, model = "t", nu = 5
)\$centers[1, , 1]))
expect_true(test_allequal(matrixmixture(c_mat,
prior = c(.5, .5), col.mean = TRUE,
row.mean = FALSE, model = "t", nu = 5
)\$centers[, 1, 1]))
expect_true(!test_allequal(matrixmixture(c_mat,
prior = c(.5, .5), col.mean = FALSE,
row.mean = FALSE, model = "t", nu = 5
)\$centers[, 1, 1]))

llrcmix <- logLik(matrixmixture(c_mat,
prior = c(.5, .5),
col.mean = TRUE, row.mean = TRUE
))
llrmix <- logLik(matrixmixture(c_mat,
prior = c(.5, .5),
col.mean = FALSE, row.mean = TRUE
))
llcmix <- logLik(matrixmixture(c_mat,
prior = c(.5, .5),
col.mean = TRUE, row.mean = FALSE
))
llmix <- logLik(matrixmixture(c_mat,
prior = c(.5, .5),
col.mean = FALSE, row.mean = FALSE
))

lltrcmix <- logLik(matrixmixture(c_mat,
prior = c(.5, .5), col.mean = TRUE,
row.mean = TRUE, model = "t", nu = 5
))
lltrmix <- logLik(matrixmixture(c_mat,
prior = c(.5, .5), col.mean = FALSE,
row.mean = TRUE, model = "t", nu = 5
))
lltcmix <- logLik(matrixmixture(c_mat,
prior = c(.5, .5), col.mean = TRUE,
row.mean = FALSE, model = "t", nu = 5
))
lltmix <- logLik(matrixmixture(c_mat,
prior = c(.5, .5), col.mean = FALSE,
row.mean = FALSE, model = "t", nu = 5
))

expect_equal(attributes(llrcmix)\$df, attributes(lltrcmix)\$df)
expect_equal(attributes(llmix)\$df, attributes(lltmix)\$df)
expect_equal(attributes(llcmix)\$df, attributes(lltcmix)\$df)
expect_equal(attributes(llrmix)\$df, attributes(lltrmix)\$df)
expect_lt(attributes(llrcmix)\$df, attributes(llcmix)\$df)
expect_lt(attributes(llcmix)\$df, attributes(llmix)\$df)
expect_lt(attributes(llrmix)\$df, attributes(llmix)\$df)
})

test_that("Predict Mix Model works", {
set.seed(20180221)
a_mat <- rmatrixnorm(15, mean = matrix(0, nrow = 3, ncol = 4))
b_mat <- rmatrixnorm(15, mean = matrix(1, nrow = 3, ncol = 4))
c_mat <- array(c(a_mat, b_mat), dim = c(3, 4, 30))
prior <- c(.5, .5)

mix <- matrixmixture(c_mat, prior = c(.5, .5))
mixt <- matrixmixture(c_mat, prior = c(.5, .5), model = "t", nu = 5)
expect_error(
predict(mix, newdata = matrix(0, nrow = 3, ncol = 2)),
"dimension"
)
expect_error(
predict(mix, newdata = (matrix(0, nrow = 2, ncol = 3))),
"dimension"
)

expect_equal(sum(predict(mix, newdata = matrix(
0,
nrow = 3, ncol = 4
))\$posterior), 1)
expect_equal(sum(predict(mix, prior = c(.7, .3))\$posterior[1, ]), 1)
expect_equal(sum(predict(mixt, newdata = matrix(
0,
nrow = 3, ncol = 4
))\$posterior), 1)
expect_equal(sum(predict(mixt, prior = c(.7, .3))\$posterior[1, ]), 1)
})

test_that("Init function works", {
set.seed(20180221)
a_mat <- rmatrixnorm(15, mean = matrix(0, nrow = 3, ncol = 4))
b_mat <- rmatrixnorm(15, mean = matrix(1, nrow = 3, ncol = 4))
c_mat <- array(c(a_mat, b_mat), dim = c(3, 4, 30))
prior <- c(.5, .5)

testinit <- init_matrixmixture(c_mat,
K = 2, centers = matrix(7, 3, 4),
U = 4 * diag(3), V = 3 * diag(4)
)
testinit_two <- init_matrixmixture(c_mat,
K = 2,
init = list(
centers = matrix(7, 3, 4),
U = 4 * diag(3),
V = 3 * diag(4)
)
)
expect_equal(testinit\$U[1, 1, 1], 4)
expect_equal(testinit\$U[2, 2, 2], 4)
expect_equal(testinit\$V[2, 2, 2], 3)
expect_equal(testinit\$centers[1, 1, 2], 7)
expect_equal(testinit_two\$U[1, 1, 1], 4)
expect_equal(testinit_two\$U[2, 2, 2], 4)
expect_equal(testinit\$V[2, 2, 2], 3)
expect_equal(testinit_two\$centers[1, 1, 2], 7)
})

## Try the MixMatrix package in your browser

Any scripts or data that you put into this service are public.

MixMatrix documentation built on Nov. 16, 2021, 9:25 a.m.