Nothing
tests/testthat/test-struct_em.R
gmm_1 <- list(alpha = 1, mu = matrix(0, dimnames = list("A", NULL)),
sigma = list(matrix(1, dimnames = list("A", "A"))))
class(gmm_1) <- "gmm"
gmm_2 <- list(alpha = 1, mu = matrix(0, dimnames = list("B", NULL)),
sigma = list(matrix(1, dimnames = list("B", "B"))))
class(gmm_2) <- "gmm"
gmm_3 <- list(alpha = 1, mu = matrix(0, dimnames = list("C", NULL)),
sigma = list(matrix(1, dimnames = list("C", "C"))))
class(gmm_3) <- "gmm"
gmm_4 <- list(alpha = c(0.1661748, 0.8338252),
mu = matrix(c(6.650029e-140, 3.948111), 1,
dimnames = list("A", NULL)),
sigma = list(matrix(0.005007389, dimnames = list("A", "A")),
matrix(1.726536, dimnames = list("A", "A"))))
class(gmm_4) <- "gmm"
gmm_5 <- list(alpha = c(0.1666667, 0.1666667, 0.5, 0.1666667),
mu = matrix(c(7, 9, 6.094894, 3.530951), 1,
dimnames = list("B", NULL)),
sigma = list(matrix(0.005, dimnames = list("B", "B")),
matrix(0.005, dimnames = list("B", "B")),
matrix(0.01450626, dimnames = list("B", "B")),
matrix(0.005, dimnames = list("B", "B"))))
class(gmm_5) <- "gmm"
gmm_6 <- list(alpha = c(0.3333333, 0.6666667),
mu = matrix(c(6.7903344, 0.9002508, 3.763442, 4.487926), 2,
dimnames = list(c("C", "A"), NULL)),
sigma = list(matrix(c(0.9788607, - 0.7260016, - 0.7260016,
0.5436343),
2, dimnames = list(c("C", "A"), c("C", "A"))),
matrix(c(0.9597421, 0.9010994, 0.9010994, 0.9080968),
2,
dimnames = list(c("C", "A"), c("C", "A")))))
class(gmm_6) <- "gmm"
gmm_7 <- list(alpha = 1, mu = matrix(2.304809, dimnames = list("A", NULL)),
sigma = list(matrix(4.271348, dimnames = list("A", "A"))))
class(gmm_7) <- "gmm"
gmm_8 <- list(alpha = c(0.3333333, 0.3333242, 0.3333425),
mu = matrix(c(- 0.3334605, 4.5, 7.7765522, 0.4400948, 7.499986,
1.974289),
2, dimnames = list(c("B", "A"), NULL)),
sigma = list(matrix(c(0.01385594, 0.12563401, 0.12563401,
1.503333),
2, dimnames = list(c("B", "A"), c("B", "A"))),
matrix(c(0.4053299, - 0.2278356, - 0.2278356,
0.1324616),
2, dimnames = list(c("B", "A"), c("B", "A"))),
matrix(c(1.50331, 2.023787, 2.023787, 2.733853),
2,
dimnames = list(c("B", "A"), c("B", "A")))))
class(gmm_8) <- "gmm"
gmm_9 <- list(alpha = c(0.5, 0.5),
mu = matrix(c(1.243403, 1.276906, 6.316625, 3.332711), 2,
dimnames = list(c("C", "A"), NULL)),
sigma = list(matrix(c(0.2909673, 0.5781801, 0.5781801, 1.2239391),
2, dimnames = list(c("C", "A"), c("C", "A"))),
matrix(c(1.17794, - 2.341516, - 2.341516, 4.668545),
2,
dimnames = list(c("C", "A"), c("C", "A")))))
class(gmm_9) <- "gmm"
gmm_10 <- list(alpha = 1, mu = matrix(0.02661075, dimnames = list("A", NULL)),
sigma = list(matrix(0.003805421, dimnames = list("A", "A"))))
class(gmm_10) <- "gmm"
gmm_11 <- list(alpha = c(0.5, 0.5),
mu = matrix(c(5.017594, 6), 1, dimnames = list("B", NULL)),
sigma = list(matrix(0.005, dimnames = list("B", "B")),
matrix(0.005, dimnames = list("B", "B"))))
class(gmm_11) <- "gmm"
gmm_12 <- list(alpha = c(0.75, 0.25),
mu = matrix(c(3.058225, 6), 1, dimnames = list("A", NULL)),
sigma = list(matrix(0.1007646, dimnames = list("A", "A")),
matrix(0.005, dimnames = list("A", "A"))))
class(gmm_12) <- "gmm"
gmm_13 <- list(alpha = c(0.25, 0.25, 0.5),
mu = matrix(c(1.60097, 3, 9, 3.527776, 7.175548, 4.323449), 2,
dimnames = list(c("B", "A"), NULL)),
sigma = list(matrix(c(0.005, 0, 0, 0.005), 2,
dimnames = list(c("B", "A"), c("B", "A"))),
matrix(c(5e-03, 5.674337e-207, 5.674337e-207,
5e-03),
2,
dimnames = list(c("B", "A"), c("B", "A"))),
matrix(c(0.02387817, 0.1962106, 0.1962106,
1.8772153),
2,
dimnames = list(c("B", "A"), c("B", "A")))))
class(gmm_13) <- "gmm"
gmm_14 <- list(alpha = 1,
mu = matrix(0.01677451, dimnames = list("A", NULL)),
sigma = list(matrix(0.003520923, dimnames = list("A", "A"))))
class(gmm_14) <- "gmm"
gmm_15 <- list(alpha = 1, mu = matrix(6.003919, dimnames = list("B", NULL)),
sigma = list(matrix(0.003343572, dimnames = list("B", "B"))))
class(gmm_15) <- "gmm"
gmm_16 <- list(alpha = c(0.25, 0.25, 0.25, 0.25),
mu = matrix(c(- 0.3212006, 1.448437, 3, 6), 1,
dimnames = list("A", NULL)),
sigma = list(matrix(0.005, dimnames = list("A", "A")),
matrix(0.005, dimnames = list("A", "A")),
matrix(0.005, dimnames = list("A", "A")),
matrix(0.005, dimnames = list("A", "A"))))
class(gmm_16) <- "gmm"
gmm_17 <- list(alpha = c(0.5, 0.5),
mu = matrix(c(- 0.1647741, 6.5, 8, 2.98028), 2,
dimnames = list(c("B", "B.1"), NULL)),
sigma = list(matrix(c(0.0125369, - 0.0391654, - 0.0391654, 0.17),
2,
dimnames = list(c("B", "B.1"),
c("B", "B.1"))),
matrix(c(0.67, - 2.018372, - 2.018372, 6.114071), 2,
dimnames = list(c("B", "B.1"),
c("B", "B.1")))))
class(gmm_17) <- "gmm"
gmbn_1 <- list(A = gmm_1, B = gmm_2, C = gmm_3)
class(gmbn_1) <- "gmbn"
gmbn_2 <- list(A = gmm_4, B = gmm_5, C = gmm_6)
class(gmbn_2) <- "gmbn"
gmbn_3 <- list(A = gmm_7, B = gmm_8, C = gmm_9)
class(gmbn_3) <- "gmbn"
gmbn_4 <- list(A = gmm_1, B = gmm_2)
class(gmbn_4) <- "gmbn"
gmbn_5 <- list(A = gmm_10, B = gmm_11)
class(gmbn_5) <- "gmbn"
gmbn_6 <- list(A = gmm_12, B = gmm_13)
class(gmbn_6) <- "gmbn"
gmbn_7 <- list(A = gmm_14, B = gmm_15)
class(gmbn_7) <- "gmbn"
gmbn_8 <- list(A = gmm_16, B = gmm_17)
class(gmbn_8) <- "gmbn"
gmdbn_1 <- list(b_1 = gmbn_4, b_2 = gmbn_4)
class(gmdbn_1) <- "gmdbn"
gmdbn_2 <- list(b_1 = gmbn_5, b_2 = gmbn_6)
class(gmdbn_2) <- "gmdbn"
gmdbn_3 <- list(b_1 = gmbn_7, b_2 = gmbn_8)
class(gmdbn_3) <- "gmdbn"
test_that("perform the structural EM algorithm for a gmbn object", {
set.seed(0)
expect_equal(struct_em(gmbn_1,
data.frame(A = c(0, NA, 6, NA, 3, NA),
B = c(NA, 7, NA, 6, NA, 9),
C = c(8, NA, 5, NA, 2, NA)),
arcs_cand = data.frame(from = c("A", "A", "B"),
to = c("B", "C", "C")),
n_part = 2, max_iter_sem = 2, max_iter_pem = 2,
max_iter_step = 2, max_iter_smem = 2, regul = 0.01,
max_iter_em = 5),
list(gmgm = gmbn_2,
data = tibble(A = c(0, 4.35, 6, 4.6, 3, 1.8),
B = c(6.27, 7, 3.53, 6, 6.01, 9),
C = c(8, 3.95, 5, 4.1, 2, 5.58)),
seq_score = matrix(c(- 46.2276, - 37.24874, - 44.13652,
- 32.27129),
2, dimnames = list(c("E", "M"), NULL))),
tolerance = 0.01)
})
test_that("perform the structural EM algorithm for a gmbn object with explicit arguments", {
set.seed(0)
expect_equal(struct_em(gmbn_1,
data.frame(A = c(0, NA, 6, NA, 3, NA),
B = c(NA, 7, NA, 6, NA, 9),
C = c(8, NA, 5, NA, 2, NA)),
c("A", "B","C"),
data.frame(from = c("A", "A", "B"),
to = c("B", "C", "C")),
NULL, "bic", 2, 1e06, 1, 2, 2, FALSE, TRUE, TRUE, 0,
Inf, 2, TRUE, TRUE, 1, Inf, 0.5, Inf, 2, 0.01, 1e-06,
5),
list(gmgm = gmbn_2,
data = tibble(A = c(0, 4.35, 6, 4.6, 3, 1.8),
B = c(6.27, 7, 3.53, 6, 6.01, 9),
C = c(8, 3.95, 5, 4.1, 2, 5.58)),
seq_score = matrix(c(- 46.2276, - 37.24874, - 44.13652,
- 32.27129),
2, dimnames = list(c("E", "M"), NULL))),
tolerance = 0.01)
})
test_that("perform the structural EM algorithm for a gmbn object with no iteration of the parametric EM algorithm", {
set.seed(0)
expect_equal(struct_em(gmbn_1,
data.frame(A = c(0, NA, 6, NA, 3, NA),
B = c(NA, 7, NA, 6, NA, 9),
C = c(8, NA, 5, NA, 2, NA)),
arcs_cand = data.frame(from = c("A", "A", "B"),
to = c("B", "C", "C")),
n_part = 2, max_iter_sem = 3, max_iter_pem = 0,
max_iter_step = 2, max_iter_smem = 2, regul = 0.01,
max_iter_em = 5),
list(gmgm = gmbn_3,
data = tibble(A = c(0, 0.88, 6, - 0.0495, 3, 4),
B = c(8.55, 7, - 0.208, 6, - 0.459, 9),
C = c(8, 1.25, 5, 0.481, 2, 5.95)),
seq_score = matrix(c(- 175.83553, - 38.83331, - 143.6634,
- 30.7931, - 99.07375, - 31.68701),
2, dimnames = list(c("E", "M"), NULL))),
tolerance = 0.01)
})
test_that("perform no iteration of the structural EM algorithm for a gmbn object", {
expect_equal(struct_em(gmbn_1,
data.frame(A = c(0, NA, 6, NA, 3, NA),
B = c(NA, 7, NA, 6, NA, 9)),
max_iter_sem = 0),
list(gmgm = gmbn_1, data = NULL,
seq_score = matrix(numeric(), 2,
dimnames = list(c("E", "M"), NULL))),
tolerance = 0.01)
})
test_that("perform the structural EM algorithm for a gmbn object with verbose", {
set.seed(0)
expect_equal(struct_em(gmbn_1,
data.frame(A = c(0, NA, 6, NA, 3, NA),
B = c(NA, 7, NA, 6, NA, 9),
C = c(8, NA, 5, NA, 2, NA)),
arcs_cand = data.frame(from = c("A", "A", "B"),
to = c("B", "C", "C")),
n_part = 2, max_iter_sem = 2, max_iter_pem = 2,
verbose = TRUE, max_iter_step = 2, max_iter_smem = 2,
regul = 0.01, max_iter_em = 5),
list(gmgm = gmbn_2,
data = tibble(A = c(0, 4.35, 6, 4.6, 3, 1.8),
B = c(6.27, 7, 3.53, 6, 6.01, 9),
C = c(8, 3.95, 5, 4.1, 2, 5.58)),
seq_score = matrix(c(- 46.2276, - 37.24874, - 44.13652,
- 32.27129),
2, dimnames = list(c("E", "M"), NULL))),
tolerance = 0.01)
})
test_that("perform the structural EM algorithm for a gmdbn object", {
set.seed(0)
expect_equal(struct_em(gmdbn_1,
data.frame(seq = c(1, 1, 1, 2, 2, 2),
A = c(0, NA, 6, NA, 3, NA),
B = c(NA, 7, NA, 6, NA, 9)),
arcs_cand = data.frame(from = c("A", "A", "A", "B"),
to = c("A", "B", "B", "B"),
lag = c(0, 0, 1, 1)),
col_seq = "seq", n_part = 2, max_iter_sem = 2,
max_iter_pem = 2, max_iter_step = 2, max_iter_smem = 2,
regul = 0.01, max_iter_em = 5),
list(gmgm = gmdbn_2,
data = tibble(seq = c(1, 1, 1, 2, 2, 2),
A = c(0, 2.65, 6, 0.0532, 3, 3.53),
B = c(5.02, 7, 7.35, 6, 1.6, 9)),
seq_score = matrix(c(- 21.98519, - 11.29735, - 9.619716,
- 6.668585),
2, dimnames = list(c("E", "M"), NULL))),
tolerance = 0.01)
})
test_that("perform the structural EM algorithm for a gmdbn object with no iteration of the parametric EM algorithm", {
set.seed(0)
expect_equal(struct_em(gmdbn_1,
data.frame(seq = c(1, 1, 1, 2, 2, 2),
A = c(0, NA, 6, NA, 3, NA),
B = c(NA, 7, NA, 6, NA, 9)),
arcs_cand = data.frame(from = c("A", "A", "A", "B"),
to = c("A", "B", "B", "B"),
lag = c(0, 0, 1, 1)),
col_seq = "seq", n_part = 2, max_iter_sem = 3,
max_iter_pem = 0, max_iter_step = 2, max_iter_smem = 2,
regul = 0.01, max_iter_em = 5),
list(gmgm = gmdbn_3,
data = tibble(seq = c(1, 1, 1, 2, 2, 2),
A = c(0, 1.45, 6, 0.0335, 3, - 0.321),
B = c(6.01, 7, - 0.282, 6, - 0.0473, 9)),
seq_score = matrix(c(- 121.076241, - 9.587937,
- 6043.824772, - 2.740334,
- 193.299192, - 2.315253),
2, dimnames = list(c("E", "M"), NULL))),
tolerance = 0.01)
})
Try the gmgm package in your browser
Any scripts or data that you put into this service are public.
