em_lbfgs to em_dnm

helske · Nov 23, 2024 · 29a9fe1 · 29a9fe1
1 parent e927dd6
commit 29a9fe1
Show file tree

Hide file tree

Showing 7 changed files with 30 additions and 22 deletions.
diff --git a/tests/testthat/test-build_mnhmm.R b/tests/testthat/test-build_mnhmm.R
@@ -44,7 +44,8 @@ test_that("estimate_mnhmm returns object of class 'mnhmm'", {
     fit <- estimate_mnhmm(
       "y", s, d, initial_formula = ~ x, transition_formula = ~z,
       emission_formula = ~ z, cluster_formula = ~ x,
-      data = data, time = "time", id = "id", maxeval = 1),
+      data = data, time = "time", id = "id", maxeval = 1,
+      method = "EM"),
     NA
   )
   expect_s3_class(
@@ -55,7 +56,7 @@ test_that("estimate_mnhmm returns object of class 'mnhmm'", {
     fit <- estimate_mnhmm(
       c("y", "y2"), s, d, initial_formula = ~ x, transition_formula = ~z,
       emission_formula = ~ z, cluster_formula = ~ x,
-      data = data, time = "time", id = "id", maxeval = 1),
+      data = data, time = "time", id = "id", maxeval = 1, method = "DNM"),
     NA
   )
   expect_s3_class(
@@ -126,7 +127,7 @@ test_that("estimate_mnhmm errors with incorrect observations", {
 test_that("build_mnhmm works with vector of characters as observations", {
   expect_error(
     model <- estimate_mnhmm("y", s, d, data = data, time = "time", id = "id",
-                            maxeval = 1),
+                            maxeval = 1, em_dnm_maxeval = 1),
     NA
   )
   expect_error(
@@ -144,12 +145,13 @@ test_that("build_mnhmm works with missing observations", {
   data$y[50:55] <- NA
   expect_error(
     model <- estimate_mnhmm(
-      "y", s, d, data = data, time = "time", id = "id", maxeval = 1),
+      "y", s, d, data = data, time = "time", id = "id", maxeval = 1,
+      em_dnm_maxeval = 1),
     NA
   )
   expect_equal(
     which(model$observations == "*"),
     c(41L, 42L, 43L, 44L, 45L, 46L, 47L, 48L, 49L, 50L, 60L, 61L, 
       62L, 63L, 64L, 65L)
   )
-})
+})
diff --git a/tests/testthat/test-forward_backward.R b/tests/testthat/test-forward_backward.R
@@ -39,7 +39,7 @@ test_that("'forward_backward' works for multichannel 'nhmm'", {
       hmm_biofam$observations, n_states = 5,
       inits = hmm_biofam[
         c("initial_probs", "transition_probs", "emission_probs")
-      ], maxeval = 1
+      ], maxeval = 1, method = "DNM"
     ),
     NA
   )
@@ -65,7 +65,7 @@ test_that("'forward_backward' works for single-channel 'nhmm'", {
   expect_error(
     fit <- estimate_nhmm(
       hmm_biofam$observations[[1]][1:100,], n_states = 3,
-      restarts = 2, maxeval = 2, lambda = 1
+      restarts = 2, maxeval = 2, lambda = 1, method = "EM"
     ),
     NA
   )
@@ -92,7 +92,7 @@ test_that("'forward_backward' works for multichannel 'mnhmm'", {
   expect_error(
     fit <- estimate_mnhmm(
       hmm_biofam$observations, n_states = 3, n_clusters = 2,
-      maxeval = 1
+      maxeval = 1, method = "EM"
     ),
     NA
   )
@@ -118,7 +118,7 @@ test_that("'forward_backward' works for single-channel 'mnhmm'", {
   expect_error(
     fit <- estimate_mnhmm(
       hmm_biofam$observations[[1]], n_states = 4, n_clusters = 2,
-      restarts = 2, maxeval = 1
+      restarts = 2, maxeval = 1, method = "EM"
     ),
     NA
   )

diff --git a/tests/testthat/test-get_probs.R b/tests/testthat/test-get_probs.R
@@ -43,7 +43,8 @@ test_that("'get_probs' and 'coef' works for multichannel 'mnhmm'", {
   set.seed(1)
   expect_error(
     fit <- estimate_mnhmm(
-      hmm_biofam$observations, n_states = 3, n_clusters = 2, maxeval = 1
+      hmm_biofam$observations, n_states = 3, n_clusters = 2, maxeval = 1,
+      em_dnm_maxeval = 1
     ),
     NA
   )
@@ -70,7 +71,8 @@ test_that("'get_probs' and 'coef' works for single-channel 'mnhmm'", {
       hmm_biofam$observations[[1]][1:50, ], n_states = 4, n_clusters = 2, 
       initial_formula = ~ z, cluster_formula = ~ z, 
       transition_formula = ~w, emission_formula = ~ w, 
-      data = d, time = "time", id = "group", maxeval = 1
+      data = d, time = "time", id = "group", maxeval = 1,
+      em_dnm_maxeval = 1
     ),
     NA
   )

diff --git a/tests/testthat/test-hidden_paths.R b/tests/testthat/test-hidden_paths.R
@@ -25,7 +25,7 @@ test_that("'hidden_paths' works for 'nhmm'", {
       hmm_biofam$observations, n_states = 5,
       inits = hmm_biofam[
         c("initial_probs", "transition_probs", "emission_probs")
-      ], maxeval = 1, labmda = 1
+      ], maxeval = 1, lambda = 1, method = "DNM"
     ),
     NA
   )
@@ -57,7 +57,8 @@ test_that("'hidden_paths' works for 'mnhmm'", {
   set.seed(1)
   expect_error(
     fit <- estimate_mnhmm(
-      hmm_biofam$observations, n_states = 3, n_clusters = 2, maxeval = 1
+      hmm_biofam$observations, n_states = 3, n_clusters = 2, maxeval = 1,
+      em_dnm_maxeval = 1
     ),
     NA
   )
@@ -72,7 +73,7 @@ test_that("'hidden_paths' works for 'mnhmm'", {
   expect_error(
     fit <- estimate_mnhmm(
       hmm_biofam$observations[[1]], n_states = 3, n_clusters = 2,
-      restarts = 2, maxeval = 1
+      restarts = 2, maxeval = 1, method = "EM"
     ),
     NA
   )

diff --git a/tests/testthat/test-posterior_probs.R b/tests/testthat/test-posterior_probs.R
@@ -41,7 +41,7 @@ test_that("'posterior_probs' works for 'nhmm'", {
       hmm_biofam$observations, n_states = 5,
       inits = hmm_biofam[
         c("initial_probs", "transition_probs", "emission_probs")
-      ], maxeval = 100
+      ], maxeval = 100, method = "DNM"
     ),
     NA
   )
@@ -72,7 +72,8 @@ test_that("'posterior_probs' works for 'mnhmm'", {
   set.seed(1)
   expect_error(
     fit <- estimate_mnhmm(
-      hmm_biofam$observations, n_states = 3, n_clusters = 2, maxeval = 1
+      hmm_biofam$observations, n_states = 3, n_clusters = 2, maxeval = 1,
+      method = "EM"
     ),
     NA
   )
@@ -86,7 +87,8 @@ test_that("'posterior_probs' works for 'mnhmm'", {
   set.seed(1)
   expect_error(
     fit <- estimate_mnhmm(
-      hmm_biofam$observations[[1]], n_states = 3, n_clusters = 2, maxeval = 1
+      hmm_biofam$observations[[1]], n_states = 3, n_clusters = 2, maxeval = 1,
+      em_dnm_maxeval = 1
     ),
     NA
   )

diff --git a/tests/testthat/test-simulate_mnhmm.R b/tests/testthat/test-simulate_mnhmm.R
@@ -42,7 +42,8 @@ test_that("simulate_mnhmm, coef and get_probs works", {
       initial_formula = ~1, transition_formula = ~ x, 
       emission_formula = ~ x + z, cluster_formula = ~w, 
       data = d, time = "month", id = "person", 
-      inits = sim$model$etas, maxeval = 1),
+      inits = sim$model$etas, maxeval = 1,
+      em_dnm_maxeval = 1),
     NA
   )
   expect_error(

diff --git a/tests/testthat/test-state_obs_probs.R b/tests/testthat/test-state_obs_probs.R
@@ -7,7 +7,7 @@ test_that("'state_obs_probs' works for multichannel 'nhmm'", {
       hmm_biofam$observations, n_states = 5,
       inits = hmm_biofam[
         c("initial_probs", "transition_probs", "emission_probs")
-      ], maxeval = 1
+      ], maxeval = 1, method = "DNM"
     ),
     NA
   )
@@ -53,7 +53,7 @@ test_that("'state_obs_probs' works for single-channel 'nhmm'", {
   expect_error(
     fit <- estimate_nhmm(
       hmm_biofam$observations[[1]][1:100,], n_states = 3,
-      restarts = 2, maxeval = 2, lambda = 1
+      restarts = 2, maxeval = 2, lambda = 1, method = "DNM"
     ),
     NA
   )
@@ -82,7 +82,7 @@ test_that("'state_obs_probs' works for multichannel 'mnhmm'", {
   expect_error(
     fit <- estimate_mnhmm(
       hmm_biofam$observations, n_states = 3, n_clusters = 2,
-      maxeval = 1
+      maxeval = 1, em_dnm_maxeval = 1
     ),
     NA
   )
@@ -112,7 +112,7 @@ test_that("'state_obs_probs' works for single-channel 'mnhmm'", {
   expect_error(
     fit <- estimate_mnhmm(
       hmm_biofam$observations[[1]], n_states = 4, n_clusters = 2,
-      restarts = 2, maxeval = 1
+      restarts = 2, maxeval = 1, method = "DNM", algorithm = "NLOPT_LN_COBYLA"
     ),
     NA
   )