fix predict

R/average_marginal_prediction.R

@@ -38,10 +38,10 @@ average_marginal_prediction <- function(
     "Argument {.arg variable} must be a single character string."
   )
   stopifnot_(
-    length(values) != 2, 
+    length(values) == 2, 
     "Argument {.arg values} should contain two values for 
     variable {.var variable}.")
-  if (is.null(newdata)) {
+  if (!is.null(newdata)) {
     time <- model$time_variable
     id <- model$id_variable
     stopifnot_(
@@ -62,7 +62,7 @@ average_marginal_prediction <- function(
     )
   } else {
     stopifnot_(
-      !is.null(model$data),
+      is.null(model$data),
       "Model does not contain original data and argument {.arg newdata} is 
       {.var NULL}."
     )

R/predict.R

@@ -34,7 +34,7 @@ predict.nhmm <- function(
     )
   } else {
     stopifnot_(
-      !is.null(object$data),
+      is.null(object$data),
       "Model does not contain original data and argument {.arg newdata} is 
       {.var NULL}."
     )
@@ -105,22 +105,22 @@ predict.mnhmm <- function(
     )
   } else {
     stopifnot_(
-      !is.null(object$data),
+      is.null(object$data),
       "Model does not contain original data and argument {.arg newdata} is 
       {.var NULL}."
     )
     object <- update(object, newdata = newdata)
   }
 
   beta_i_raw <- stan_to_cpp_initial(
-    object$coefficients$beta_i_raw
+    object$coefficients$beta_i_raw, object$n_clusters
   )
   beta_s_raw <- stan_to_cpp_transition(
-    object$coefficients$beta_s_raw
+    object$coefficients$beta_s_raw, object$n_clusters
   )
   beta_o_raw <- stan_to_cpp_emission(
     object$coefficients$beta_o_raw,
-    1,
+    object$n_clusters,
     object$n_channels > 1
   )
   X_initial <- t(object$X_initial)

tests/testthat/test-build_mnhmm.R

@@ -108,7 +108,8 @@ test_that("estimate_mnhmm errors with incorrect observations", {
 })
 test_that("build_mnhmm works with vector of characters as observations", {
   expect_error(
-    estimate_mnhmm("y", s, d, data = data, time = "time", id = "id", iter = 0),
+    estimate_mnhmm("y", s, d, data = data, time = "time", id = "id", iter = 0,
+                   verbose = FALSE),
     NA
   )
 })

tests/testthat/test-build_nhmm.R

@@ -22,8 +22,7 @@ test_that("build_nhmm returns object of class 'nhmm'", {
     model <- build_nhmm(
       obs, s, initial_formula = ~ x, transition_formula = ~z,
       emission_formula = ~ z, data = data, 
-      time = "time", id = "id", state_names = 1:s, channel_names = "obs", 
-      verbose = FALSE
+      time = "time", id = "id", state_names = 1:s, channel_names = "obs"
     ),
     NA
   )
@@ -97,7 +96,8 @@ test_that("estimate_nhmm errors with incorrect observations", {
 })
 test_that("build_nhmm works with vector of characters as observations", {
   expect_error(
-    estimate_nhmm("y", s, data = data, time = "time", id = "id", iter = 0),
+    estimate_nhmm("y", s, data = data, time = "time", id = "id", iter = 0,
+                  verbose = FALSE),
     NA
   )
 })

tests/testthat/test-simulate_mnhmm.R

@@ -37,12 +37,12 @@ test_that("simulate_mnhmm, coef and get_probs works", {
   )
   expect_error(
     fit <- estimate_mnhmm(
-      sim$observations, n_states = 2, 
+      sim$model$obs, n_states = 2, 
       n_clusters = 3, 
       initial_formula = ~1, transition_formula = ~ x, 
       emission_formula = ~ x + z, cluster_formula = ~w, 
       data = d, time = "month", id = "person", 
-      init = sim$model$coefficients, 
+      inits = sim$model$coefficients, 
       iter = 1, verbose = FALSE, hessian = FALSE),
     NA
   )