tests/testthat/test-csprob.R

In FoReco: Forecast Reconciliation

# test cross-sectional reconciliation
if (require(testthat)) {
  A <- matrix(c(1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 1, 1), 3, byrow = TRUE)
  colnames(A) <- LETTERS[4:7]
  rownames(A) <- LETTERS[1:3]
  set.seed(123)
  res <- matrix(rnorm(100 * sum(dim(A))), 100, sum(dim(A)))
  base <- t(rnorm(sum(dim(A)), 1))
  C <- (cbind(diag(NROW(A)), -A))
  colnames(C) <- LETTERS[1:7]
  comb <- "sam"
  test_that("Cross-sectional gaussian, full cov", {
    rp <- csrec(base = base, agg_mat = A, comb = comb, res = res)
    rd1 <- csmvn(base = base, agg_mat = A, comb = comb, res = res)
    rd2 <- csmvn(
      base = base,
      agg_mat = A,
      comb = comb,
      comb_base = comb,
      res = res
    )
    rd4 <- csmvn(
      base = base,
      agg_mat = A,
      comb = comb,
      res = res,
      reduce_form = TRUE
    )

    rd5 <- csmvn(
      base = base,
      agg_mat = A,
      comb = comb,
      res = res,
      approach = "strc"
    )
    rd6 <- csmvn(
      base = base,
      agg_mat = A,
      comb = comb,
      approach = "strc",
      res = res,
      reduce_form = TRUE
    )

    expect_equal(rp, mean(rd1), ignore_attr = TRUE)
    expect_equal(rp, csbu(mean(rd4), A), ignore_attr = TRUE)
    expect_equal(rp, csbu(mean(rd6), A), ignore_attr = TRUE)
    expect_equal(rd1, rd2, ignore_attr = TRUE)
    expect_equal(rd1, rd5, ignore_attr = TRUE)
    expect_equal(rd4, rd6, ignore_attr = TRUE)
  })

  comb <- "wls"
  test_that("Cross-sectional gaussian, diag cov", {
    rp <- csrec(base = base, agg_mat = A, comb = comb, res = res)
    rd1 <- csmvn(base = base, agg_mat = A, comb = comb, res = res)
    rd2 <- csmvn(
      base = base,
      agg_mat = A,
      comb = comb,
      comb_base = comb,
      res = res
    )
    rd4 <- csmvn(
      base = base,
      agg_mat = A,
      comb = comb,
      res = res,
      reduce_form = TRUE
    )

    rd5 <- csmvn(
      base = base,
      agg_mat = A,
      comb = comb,
      res = res,
      approach = "strc"
    )
    rd6 <- csmvn(
      base = base,
      agg_mat = A,
      comb = comb,
      approach = "strc",
      res = res,
      reduce_form = TRUE
    )

    expect_equal(rp, mean(rd1), ignore_attr = TRUE)
    expect_equal(rp, csbu(mean(rd4), A), ignore_attr = TRUE)
    expect_equal(rp, csbu(mean(rd6), A), ignore_attr = TRUE)
    expect_equal(rd1, rd2, ignore_attr = TRUE)
    expect_equal(rd1, rd5, ignore_attr = TRUE)
    expect_equal(rd4, rd6, ignore_attr = TRUE)
  })

  set.seed(123)
  A <- t(c(1, 1)) # Aggregation matrix for Z = X + Y

  # (100 x 3) base forecasts sample (simulated) for h = 1
  base_h1 <- matrix(rnorm(100 * 3, mean = c(20, 10, 10)), 100, byrow = TRUE)
  # (100 x 3) base forecasts sample (simulated) for h = 2
  base_h2 <- matrix(rnorm(100 * 3, mean = c(20, 10, 10)), 100, byrow = TRUE)
  # (2 x 3 x 100) base forecasts sample array with
  # 2 forecast horizons, 3 time series and 100 sample
  base_sample <- aperm(simplify2array(list(base_h1, base_h2)), c(3, 2, 1))
  res <- t(matrix(rnorm(n = 300), nrow = 3))
  comb <- "shr"
  test_that("Cross-sectional sample", {
    # Optimal cross-sectional probabilistic reconciliation
    r1 <- cssmp(base_sample, agg_mat = A, comb = comb, res = res)
    r11 <- apply(base_sample, 3, csrec, agg_mat = A, comb = comb, res = res)
    expect_equal(rowMeans(r11), as.vector(mean(r1)))

    # Bottom-up probabilistic reconciliation
    r2 <- cssmp(base_sample[, -1, ], agg_mat = A, fun = csbu)
    r21 <- apply(base_sample[, -1, ], 3, csbu, agg_mat = A)
    expect_equal(rowMeans(r21), as.vector(mean(r2)))

    # Level conditional coherent probabilistic reconciliation
    r3 <- cssmp(
      base_sample,
      agg_mat = A,
      fun = cslcc,
      comb = comb,
      res = res
    )
    r31 <- apply(base_sample, 3, cslcc, agg_mat = A, comb = comb, res = res)
    expect_equal(rowMeans(r31), as.vector(mean(r3)))
  })
}