# tests/testthat/test-hts.R In 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))
})
```

## Try the hts package in your browser

Any scripts or data that you put into this service are public.

hts documentation built on April 1, 2018, 12:09 p.m.