tests/testthat/test.trp_regime_fit_model.data.frame.R

In ricky-kotecha/rkHMM:

test_that("fit_regime_model", {
  set.seed(1)
  g1 <- rnorm(500, mean = 0.30, sd = 0.03)
  g2 <- rnorm(500, mean = -0.10, 0.01)
  g <- c(g1, g2)
  g <- data.frame(g)

  fit <- fit_regime_model(
    g,
    number_of_states = 2,
    verbose = FALSE
  )

  expect_equal(fit$input_indices, "g")
  expect_true(any("g" %in% names(fit$time_series)))

  z <- fit$states
  expect_equal(z$sd, z$sd[order(z$sd)])

  state_sds <- dplyr::group_by(fit$time_series, state) %>%
    dplyr::summarise(
      actual_sd = sd(g),
      expected_sd = first(sd)
    )

  expect_equal(order(state_sds$expected_sd), 1:length(state_sds$expected_sd))

  # state 1 is the med vol
  expect_true(fit$time_series$state[750] == 1)
  expect_true(fit$time_series$S1[250] < 0.5)
  expect_true(fit$time_series$S1[750] > 0.5)

  # state 2 is the low vol
  expect_true(fit$time_series$state[250] == 2)
  expect_true(fit$time_series$S2[250] > 0.5)
  expect_true(fit$time_series$S2[750] < 0.5)

  expect_true(all(abs(rowSums(fit$transition_matrix) - 1) < 1e-8))

  # state 1 can only go to 1
  # state 2 can only go to 2 or 1

  expect_true(fit$transition_matrix[1, 1] > 0.999)
  expect_true(fit$transition_matrix[1, 2] < 0.001)

  expect_true(fit$transition_matrix[2, 2] < fit$transition_matrix[1, 1])
  expect_true(fit$transition_matrix[2, 1] > 0.001)
})

#################### End of fit tests ###########################

test_that("rdirichlet", {
  expect_false(any(is.na(rdirichlet(15000, rep(.01, 2)))))
})

test_that("forward_probabilities single variable", {
  # insample is low vol followed by high vol
  insample_ts <- data.frame(y = append(rnorm(100, mean = 10, sd = 1),  rnorm(100, mean = 50, sd = 4)))

  outsample_ts <- data.frame(
    c(rnorm(100, mean = 30,  sd = 5), rnorm(100, mean = 8, sd = 0.9))
  )

  fit <- fit_regime_model(insample_ts)

  z <- forward_probabilities(
    time_series = outsample_ts,
    model_fit = fit
  )
  expect_true(all(z$S2[40:60] > 0.9))
  expect_true(all(z$S1[140:200] > 0.9))

  fit$transition_matrix <- NULL
  expect_error(forward_probabilities(outsample_ts, fit), "Missing transition matrix")
})