tests/testthat/test-hts.R

In robjhyndman/hts: Hierarchical and Grouped Time Series

# A unit test for hts() function
context("Tests on inputs")

test_that("tests for y as a mts", {
  set.seed(1234)
  sts <- ts(rnorm(100), start = c(2001, 1), frequency = 12)
  node.list <- list(3, c(2, 3, 1), c(2, 2, 1, 1, 1, 3))

  expect_that(hts(sts, node.list), throws_error())
})

test_that("tests for node as a list", {
  set.seed(1234)
  mts <- ts(matrix(5 + sort(rnorm(500)), nrow = 50, ncol = 10))
  node.mat <- matrix(1:10, nrow = 2, ncol = 5)

  expect_that(hts(mts, node.mat), throws_error())
})

test_that("tests for node by default", {
  set.seed(1234)
  mts <- ts(matrix(5 + sort(rnorm(500)), nrow = 50, ncol = 10))
  nodes <- list("Level 1" = 10)

  expect_that(hts(mts)$nodes, equals(nodes))
})

test_that("tests for the root node not specified", {
  set.seed(1234)
  mts <- ts(matrix(5 + sort(rnorm(500)), nrow = 50, ncol = 10))
  node.list <- list(c(2, 3, 1), c(2, 2, 1, 1, 1, 3))

  expect_that(hts(mts, node.list), throws_error())
})

test_that("tests for the terminal nodes wrong", {
  set.seed(1234)
  mts <- ts(matrix(5 + sort(rnorm(500)), nrow = 50, ncol = 10))
  node.list <- list(1, c(2, 3, 1), c(2, 2, 1, 2, 1, 3))

  expect_that(hts(mts, node.list), throws_error())
})

test_that("tests for the middle nodes wrong", {
  set.seed(1234)
  mts <- ts(matrix(5 + sort(rnorm(500)), nrow = 50, ncol = 10))
  node.list <- list(1, c(2, 4, 1), c(2, 2, 1, 1, 1, 3))

  expect_that(hts(mts, node.list), throws_error())
})

context("tests on output")

test_that("tests for the gmatrix", {
  node.list <- list(3, c(2, 3, 1), c(2, 2, 1, 1, 1, 3))
  g <- matrix(c(rep(1, 10), rep(1, 4), rep(2, 3), rep(3, 3), rep(1, 2), 
                rep(2, 2), seq(3, 5), rep(6, 3), seq(1, 10)), ncol = 10, 
                byrow = TRUE)
  class(g) <- "gmatrix"

  output <- GmatrixH(node.list)
  dimnames(output) <- NULL
  expect_that(output, equals(g))
})