tests/testthat/test.em.R

In ricky-kotecha/rkHMM:

n_states <- 2
init_trn_mtx <- matrix(c(0.9, 0.1, 0.1, 0.9), n_states, n_states)

test_that("test_em 2 variables", {
  means <- list(
    c(1, 1),
    c(1, 1)
  )
  st_devs = list(
    c(3, 5),
    c(3, 5)
  )
  corrs = list(
    c(0.9),
    c(0.1)
  )
  test_data <- get_multivariable_test_data(
    means = means,
    st_devs = st_devs,
    corrs = corrs
  )

  init_p <- c(0.8, 0.2)


  mv_fit <- fit_multivariable(
    time_series = test_data,
    n_states = n_states,
    init_p = init_p,
    init_trn_mtx = init_trn_mtx,
    verbose = FALSE,
    random.start = FALSE,
    use_rk = FALSE
  )

  my_mv_fit <- fit_multivariable(
    time_series = test_data,
    n_states = n_states,
    init_p = init_p,
    init_trn_mtx = init_trn_mtx,
    verbose = FALSE,
    random.start = FALSE,
    use_rk = TRUE
  )

  expect_equal(mv_fit$states, my_mv_fit$states)
  expect_equal(mv_fit$cov_matrices[[2]], my_mv_fit$cov_matrices[[2]])
  expect_equal(mv_fit$cov_matrices[[1]], my_mv_fit$cov_matrices[[1]])
  expect_equal(mv_fit$transition_matrix, my_mv_fit$transition_matrix)

  invisible(plyr::llply(
    mv_fit$cov_matrices,
    function(cov_mtx) {
      # Note the mean and variance is the same therefore we can't guarantee
      # the order of the cov matrices. However, one of covariance matrices
      # should be close
      expect_true(
        all(cov2cor(cov_mtx) - sym_mtx(corrs[[1]], FALSE) < 0.05) |
          all(cov2cor(cov_mtx) - sym_mtx(corrs[[2]], FALSE) < 0.05)
      )
    }
  ))
})

test_that("test_em", {
  corrs = list(
    c(0.9, 0.6, 0.7),
    c(0.1, 0.2, 0.3)
  )
  test_data <- get_multivariable_test_data(corrs = corrs)

  init_p <- c(0.8, 0.2)

  mv_fit <- fit_multivariable(
    time_series = test_data,
    n_states = n_states,
    init_p = init_p,
    init_trn_mtx = init_trn_mtx,
    verbose = FALSE,
    random.start = FALSE,
    use_rk = FALSE
  )

  my_mv_fit <- fit_multivariable(
    time_series = test_data,
    n_states = n_states,
    init_p = init_p,
    init_trn_mtx = init_trn_mtx,
    verbose = FALSE,
    random.start = FALSE,
    use_rk = TRUE
  )

  expect_equal(mv_fit$states, my_mv_fit$states)
  expect_equal(mv_fit$cov_matrices[[2]], my_mv_fit$cov_matrices[[2]])
  expect_equal(mv_fit$cov_matrices[[1]], my_mv_fit$cov_matrices[[1]])
  expect_equal(mv_fit$transition_matrix, my_mv_fit$transition_matrix)

  invisible(plyr::llply(
    mv_fit$cov_matrices,
    function(cov_mtx) {
      # Note the mean and variance is the same therefore we can't guarantee
      # the order of the cov matrices. However, one of covariance matrices
      # should be close
      expect_true(
        all(cov2cor(cov_mtx) - sym_mtx(corrs[[1]], FALSE) < 0.05) |
          all(cov2cor(cov_mtx) - sym_mtx(corrs[[2]], FALSE) < 0.05)
      )
    }
  ))
})