tests/testthat/test-fHMM_controls.R

In loelschlaeger/fHMM: Fitting Hidden Markov Models to Financial Data

test_that("empty controls work", {
  expect_s3_class(set_controls(), "fHMM_controls")
  expect_error(
    set_controls("not_a_list"),
    "Input 'controls' must be a list."
  )
})

test_that("warning for redundant controls work", {
  expect_warning(
    set_controls(
      list(
        "not_a_valid_control" = 1
      )
    ),
    "not_a_valid_control"
  )
  expect_warning(
    set_controls(
      list(
        "data" = list(
          "not_a_valid_control" = 1,
          "file" = dax
        )
      )
    ),
    "not_a_valid_control"
  )
  expect_warning(
    set_controls(
      list(
        "fit" = list(
          "not_a_valid_control" = 1
        )
      )
    ),
    "not_a_valid_control"
  )
})

test_that("input checks for setting controls work", {
  expect_error(
    set_controls(
      list(
        "hierarchy" = FALSE,
        "states" = 1
      )
    ),
    "'states' must be an integer greater or equal 2."
  )
  expect_error(
    set_controls(
      list(
        "hierarchy" = FALSE,
        "horizon" = 10.5
      )
    ),
    "The control 'horizon' must be a positive integer."
  )
  expect_error(
    set_controls(
      list(
        "hierarchy" = FALSE,
        "sdds" = 1
      )
    ),
    "The control 'sdds' must be a character of length 1."
  )
  expect_error(
    set_controls(
      list(
        "hierarchy" = FALSE,
        "sdds" = "t",
        "data" = list(
          "file" = 1
        )
      )
    ),
    "The control 'file' in 'data' must be a 'data.frame' or a character."
  )
  expect_error(
    set_controls(
      list(
        "hierarchy" = "not_a_boolean"
      )
    ),
    "The control 'hierarchy' must be TRUE or FALSE."
  )
  expect_error(
    set_controls(
      list(
        "hierarchy" = TRUE,
        "states" = 1:3
      )
    ),
    "The control 'states' must be a vector of integers greater or equal 2"
  )
  expect_error(
    set_controls(
      list(
        "hierarchy" = TRUE,
        "horizon" = 1:3
      )
    ),
    "The control 'horizon' must be a vector of length 2."
  )
  expect_error(
    set_controls(
      list(
        "hierarchy" = TRUE,
        "horizon" = c(10, NA),
        "period" = "wrong_symbol"
      )
    ),
    "The control 'period' must be one of 'w', 'm', 'q', 'y'."
  )
})

test_that("checks for `fit` controls work", {
  controls <- list(
    fit = list("runs" = "1")
  )
  expect_error(
    controls <- set_controls(controls),
    "The control 'runs' in 'fit' must be an integer."
  )
  controls <- list(
    fit = list("origin" = "not_a_boolean")
  )
  expect_error(
    controls <- set_controls(controls),
    "The control 'origin' in 'fit' must be a boolean."
  )
  controls <- list(
    fit = list("origin" = TRUE)
  )
  controls <- set_controls(controls)
  expect_equal(controls$fit$runs, 1)
  expect_equal(controls$fit$accept, 1:5)
  controls <- list(
    fit = list("accept" = "all")
  )
  controls <- set_controls(controls)
  expect_equal(controls$fit$accept, 1:5)
  controls <- list(
    fit = list("accept" = "bad_name")
  )
  expect_error(
    controls <- set_controls(controls),
    "The control 'accept' in 'fit' must be a vector of integers from 1 to 5."
  )
  controls <- list(
    fit = list("gradtol" = -1)
  )
  expect_error(
    controls <- set_controls(controls),
    "The control 'gradtol' in 'fit' must be a positive number."
  )
  controls <- list(
    fit = list("iterlim" = -1)
  )
  expect_error(
    controls <- set_controls(controls),
    "The control 'iterlim' in 'fit' must be a positive integer."
  )
  controls <- list(
    fit = list("print.level" = 3)
  )
  expect_error(
    controls <- set_controls(controls),
    "The control 'print.level' in 'fit' must be one of 0, 1, and 2."
  )
  controls <- list(
    fit = list("steptol" = -1)
  )
  expect_error(
    controls <- set_controls(controls),
    "The control 'steptol' in 'fit' must be a positive number."
  )
})

test_that("checks of controls for simulated HMM work", {
  controls <- list(
    states  = 2,
    sdds    = "t",
    horizon = 400,
    fit     = list("runs" = 50)
  )
  controls <- set_controls(controls)
  expect_s3_class(controls, "fHMM_controls")
  expect_snapshot(controls)
})

test_that("checks of controls for empirical HMM work", {
  controls <- list(
    states = 2,
    sdds = "t",
    horizon = 400,
    data = list(
      file = system.file("extdata", "dax.csv", package = "fHMM"),
      date_column = "Date",
      data_column = "Close"
    )
  )
  controls <- set_controls(controls)
  expect_s3_class(controls, "fHMM_controls")
  expect_snapshot(controls)
  controls <- list(
    states = 2,
    sdds = "t",
    horizon = 400,
    data = list(
      file = dax,
      date_column = "Date",
      data_column = "Close"
    )
  )
  controls <- set_controls(controls)
  expect_s3_class(controls, "fHMM_controls")
  expect_snapshot(controls)
  controls <- list(
    states = 2,
    sdds = "t",
    horizon = 400,
    data = list(
      file = dax,
      date_column = 1,
      data_column = "Close"
    )
  )
  expect_error(
    controls <- set_controls(controls),
    "'date_column' in 'data' must be a single character."
  )
  controls <- list(
    states = 2,
    sdds = "t",
    horizon = 400,
    data = list(
      file = dax,
      date_column = "Date",
      data_column = 1
    )
  )
  expect_error(
    controls <- set_controls(controls),
    "'data_column' in 'data' must be a single character."
  )
  controls <- list(
    states = 2,
    sdds = "t",
    horizon = 400,
    data = list(
      file = dax,
      date_column = "Date",
      data_column = "Close",
      logreturns = "not_a_boolean"
    )
  )
  expect_error(
    controls <- set_controls(controls),
    "The control 'logreturns' in 'data' must be a boolean."
  )
  controls <- list(
    states = 2,
    sdds = "t",
    horizon = 400,
    data = list(
      file = dax,
      date_column = NA,
      data_column = "Close"
    )
  )
  controls <- set_controls(controls)
  expect_s3_class(controls, "fHMM_controls")
  controls <- list(
    states = 2,
    sdds = "t",
    horizon = 400,
    data = list(
      file = dax,
      date_column = "Date",
      data_column = "Close",
      from = "2020-01-01",
      to = "2020-02-02"
    )
  )
  controls <- set_controls(controls)
  expect_s3_class(controls, "fHMM_controls")
})

test_that("checks of controls for simulated HHMM work", {
  controls <- list(
    hierarchy = TRUE,
    horizon = c(100, NA)
  )
  controls <- set_controls(controls)
  expect_s3_class(controls, "fHMM_controls")
  expect_snapshot(controls)
  controls <- list(
    hierarchy = TRUE,
    period = "w"
  )
  controls <- set_controls(controls)
  expect_s3_class(controls, "fHMM_controls")
  expect_snapshot(controls)
  controls <- list(
    hierarchy = TRUE,
    horizon = c(100, NA),
    period = "m"
  )
  controls <- set_controls(controls)
  expect_s3_class(controls, "fHMM_controls")
  expect_snapshot(controls)
  controls <- list(
    hierarchy = TRUE,
    horizon = c(100, 30),
    period = "y"
  )
  controls <- set_controls(controls)
  expect_s3_class(controls, "fHMM_controls")
  expect_snapshot(controls)
  controls <- list(
    hierarchy = TRUE,
    horizon = c(100, 30),
    data = list(
      "file" = dax,
      "data_column" = c("Date", "Date")
    )
  )
  controls <- set_controls(controls)
  expect_s3_class(controls, "fHMM_controls")
  expect_snapshot(controls)
})

test_that("checks of controls for empirical HHMM work", {
  controls <- list(
    hierarchy = TRUE,
    horizon = c(100, NA),
    period = "w",
    data = list(
      file = dax,
      date_column = c("Date", "Date"),
      data_column = c("Close", "Close")
    )
  )
  controls <- set_controls(controls)
  expect_true(controls$data$data_inside)
  expect_s3_class(controls, "fHMM_controls")
  expect_snapshot(controls)
  controls <- list(
    hierarchy = TRUE,
    horizon = c(NA, NA, NA),
    period = "w",
    data = list(
      file = dax,
      date_column = c("Date", "Date"),
      data_column = c("Close", "Close")
    )
  )
  expect_error(
    controls <- set_controls(controls),
    "The control 'horizon' must be a vector of length 2."
  )
  controls <- list(
    hierarchy = TRUE,
    horizon = c(100, NA),
    period = "w",
    data = list(
      file = list(dax, dax),
      date_column = c("Date", "Date"),
      data_column = c("Close", "Close")
    )
  )
  controls <- set_controls(controls)
  expect_true(controls$data$data_inside)
  expect_s3_class(controls, "fHMM_controls")
  expect_snapshot(controls)
  controls <- list(
    hierarchy = TRUE,
    horizon = c(100, NA),
    period = "w",
    data = list(
      file = list(dax, dax, dax),
      date_column = c("Date", "Date"),
      data_column = c("Close", "Close")
    )
  )
  expect_error(
    controls <- set_controls(controls),
    "The control 'file' in 'data' must be a data.frame."
  )
  controls <- list(
    hierarchy = TRUE,
    horizon = c(100, NA),
    period = "w",
    data = list(
      file = list(dax, matrix(1))
    )
  )
  expect_error(
    controls <- set_controls(controls),
    "The control 'file' in 'data' must be a data.frame."
  )
  controls <- list(
    hierarchy = TRUE,
    horizon = c(100, NA),
    period = "w",
    data = list(
      file = c("one", "two", "three")
    )
  )
  expect_error(
    controls <- set_controls(controls),
    "The control 'file' in 'data' must be a character vector of length two."
  )
  controls <- list(
    hierarchy = TRUE,
    horizon = c(100, NA),
    period = "w",
    data = list(
      file = list(dax, dax),
      date_column = c("one", "two", "three"),
      data_column = c("Close", "Close")
    )
  )
  expect_error(
    controls <- set_controls(controls),
    "'date_column' in 'data' must be a character vector of length two."
  )
  controls <- list(
    hierarchy = TRUE,
    horizon = c(100, NA),
    period = "w",
    data = list(
      file = list(dax, dax),
      date_column = c("Date", "Date"),
      data_column = c("one", "two", "three")
    )
  )
  expect_error(
    controls <- set_controls(controls),
    "'data_column' in 'data' must be a character vector of length two."
  )
  controls <- list(
    hierarchy = TRUE,
    horizon = c(100, NA),
    period = "w",
    data = list(
      file = list(dax, dax),
      date_column = c("Date", "Date"),
      data_column = c("Close", "Close"),
      logreturns = TRUE
    )
  )
  expect_error(
    controls <- set_controls(controls),
    "'logreturns' in 'data' must be a boolean vector of length two."
  )
  controls <- list(
    hierarchy = TRUE,
    horizon = c(100, NA),
    period = "w",
    data = list(
      file = list(dax, dax),
      date_column = c("Date", "Date"),
      data_column = c("Close", "Close"),
      merge = "not_a_function"
    )
  )
  expect_error(
    controls <- set_controls(controls),
    "The control 'merge' in 'data' must be a function."
  )
  controls <- list(
    hierarchy = TRUE,
    horizon = c(100, NA),
    period = "w",
    data = list(
      file = list(dax, dax),
      date_column = c("Date", "Date"),
      data_column = c("Close", "Close"),
      merge = function(x) 1:2
    )
  )
  expect_error(
    controls <- set_controls(controls),
    "'merge' in 'data' should merge a vector into a single number."
  )
  controls <- list(
    hierarchy = TRUE,
    horizon = c(100, NA),
    period = "w",
    data = list(
      file = c(system.file("extdata", "dax.csv", package = "fHMM"), 
               system.file("extdata", "dax.csv", package = "fHMM")),
      date_column = c("Date", "Date"),
      data_column = c("Close", "Close")
    )
  )
  controls <- set_controls(controls)
  expect_false(controls$data$data_inside)
  expect_s3_class(controls, "fHMM_controls")
  expect_snapshot(controls)
  controls <- list(
    hierarchy = TRUE,
    horizon = c(100, NA),
    period = "w",
    data = list(
      file = c(system.file("extdata", "dax.csv", package = "fHMM"), 
               system.file("extdata", "dax.csv", package = "fHMM")),
      data_column = c("Close", "Close")
    )
  )
  controls <- set_controls(controls)
  expect_s3_class(controls, "fHMM_controls")
  expect_snapshot(controls)
  controls <- list(
    hierarchy = TRUE,
    horizon = c(100, NA),
    period = "w",
    data = list(
      file = c(system.file("extdata", "dax.csv", package = "fHMM"), 
               system.file("extdata", "dax.csv", package = "fHMM")),
      date_column = c("Date", "Date"),
      data_column = c("Close", "Close")
    )
  )
  controls <- set_controls(controls)
  expect_s3_class(controls, "fHMM_controls")
  expect_snapshot(controls)
  controls <- list(
    hierarchy = TRUE,
    horizon = c(100, NA),
    period = "w",
    data = list(
      file = dax,
      date_column = c("bad_name", "Date"),
      data_column = c("Close", "Close")
    )
  )
  expect_error(
    controls <- set_controls(controls),
    "Date column 'bad_name' not found in supplied data.frame."
  )
  controls <- list(
    hierarchy = TRUE,
    horizon = c(100, NA),
    period = "w",
    data = list(
      file = dax,
      date_column = c("Date", "Date"),
      data_column = c("Close", "bad_name")
    )
  )
  expect_error(
    controls <- set_controls(controls),
    "Data column 'bad_name' not found in supplied data.frame."
  )
  controls <- list(
    hierarchy = TRUE,
    horizon = c(100, NA),
    period = "w",
    data = list(
      file = c(system.file("extdata", "dax.csv", package = "fHMM"), 
               system.file("extdata", "dax.csv", package = "fHMM")),
      date_column = c("bad_name", "Date"),
      data_column = c("Close", "Close")
    )
  )
  expect_error(
    controls <- set_controls(controls),
    "Date column 'bad_name' not found"
  )
  controls <- list(
    hierarchy = TRUE,
    horizon = c(100, NA),
    period = "w",
    data = list(
      file = c(system.file("extdata", "dax.csv", package = "fHMM"), 
               system.file("extdata", "dax.csv", package = "fHMM")),
      date_column = c("Date", "Date"),
      data_column = c("Close", "bad_name")
    )
  )
  expect_error(
    controls <- set_controls(controls),
    "Data column 'bad_name' not found"
  )
  controls <- list(
    hierarchy = TRUE,
    horizon = c(100, NA),
    period = "w",
    data = list(
      file = c("bad_path",
               system.file("extdata", "dax.csv", package = "fHMM")),
      date_column = c("Date", "Date"),
      data_column = c("Close", "Close")
    )
  )
  expect_error(
    controls <- set_controls(controls),
    "not found"
  )
  controls <- list(
    hierarchy = TRUE,
    horizon = c(100, NA),
    period = "w",
    data = list(
      file = c(".",
               system.file("extdata", "dax.csv", package = "fHMM")),
      date_column = c("Date", "Date"),
      data_column = c("Close", "Close")
    )
  )
  expect_error(
    controls <- set_controls(controls),
    "Unable to read"
  )
})

test_that("period control does not get overruled by default horizon", {
  controls <- set_controls(controls = list(hierarchy = TRUE, period = "m"))
  expect_identical(controls$period, "m")
  expect_identical(controls$horizon, c(100, NA))
  controls <- set_controls(hierarchy = TRUE, period = "m")
  expect_identical(controls$period, "m")
  expect_identical(controls$horizon, c(100, NA))
})