check on continuous/discrete in relationship to the hierarchy (issue #6)

IDSIA · Nov 29, 2023 · 69cc7a2 · 69cc7a2
1 parent 94d818e
commit 69cc7a2
Show file tree

Hide file tree

Showing 3 changed files with 113 additions and 0 deletions.
diff --git a/R/reconc.R b/R/reconc.R
@@ -216,6 +216,9 @@ reconc_BUIS <- function(S,
   A = split_hierarchy.res$A
   upper_base_forecasts = split_hierarchy.res$upper
   bottom_base_forecasts = split_hierarchy.res$bottom
+
+  # Check on continuous/discrete in relationship to the hierarchy
+  .check_hierfamily_rel(split_hierarchy.res, distr)
 
   # H, G
   if(.check_hierarchical(A)){

diff --git a/R/utils.R b/R/utils.R
@@ -144,6 +144,30 @@
 
 }
 
+# Checks that there is no bottom continuous variable child of a 
+# discrete upper variable
+.check_hierfamily_rel <- function(sh.res, distr, debug=FALSE) {
+  for (bi in seq_along(distr[sh.res$bottom_idxs])) {
+    distr_bottom = distr[sh.res$bottom_idxs][[bi]]
+    rel_upper_i = sh.res$A[,bi]
+    rel_distr_upper = unlist(distr[sh.res$upper_idxs])[rel_upper_i == 1]
+    err_message = "A continuous bottom distribution is child of a discrete one"
+    if (distr_bottom == .DISTR_SET2[1]) {              
+      if (sum(rel_distr_upper == .DISTR_SET2[2]) | 
+          sum(rel_distr_upper == .DISTR_SET[2]) | sum(rel_distr_upper == .DISTR_SET[3])) {
+        if (debug) { return(-1) } else { stop(err_message) }
+      }
+    }
+    if (distr_bottom == .DISTR_SET[1]) {                
+      if (sum(rel_distr_upper == .DISTR_SET2[2]) |
+          sum(rel_distr_upper == .DISTR_SET[2]) | sum(rel_distr_upper == .DISTR_SET[3])) {
+        if (debug) { return(-1) } else { stop(err_message) }
+      }
+    }
+  }
+  if (debug) { return(0) }
+}
+
 
 # Misc
 .shape <- function(m) {

diff --git a/tests/testthat/test-hierfamily_rel.R b/tests/testthat/test-hierfamily_rel.R
@@ -0,0 +1,86 @@
+test_that("Test hierfamily", {
+  S = matrix(
+    data = c(1,1,1,1,1,1,
+             1,1,0,0,0,0,
+             0,0,1,1,0,0,
+             0,0,0,0,1,1,
+             1,0,0,0,0,0,
+             0,1,0,0,0,0,
+             0,0,1,0,0,0,
+             0,0,0,1,0,0,
+             0,0,0,0,1,0,
+             0,0,0,0,0,1), ncol = 6, byrow = TRUE
+  )
+  Y = c(1,2,3,4,5,6,7,8,9,10)
+  split_hierarchy.res = .split_hierarchy(S, Y)
+
+  distr = list(
+    "continuous",
+    "continuous", "continuous","continuous",
+    "continuous","continuous","continuous","continuous","continuous","continuous"
+  )
+  expect_equal(.check_hierfamily_rel(split_hierarchy.res, distr, debug = TRUE), 0)
+
+  distr = list(
+    "continuous",
+    "discrete", "continuous","continuous",
+    "continuous","continuous","continuous","continuous","continuous","continuous"
+  )
+  expect_equal(.check_hierfamily_rel(split_hierarchy.res, distr, debug = TRUE), -1)
+
+  distr = list(
+    "discrete",
+    "continuous", "continuous","continuous",
+    "continuous","continuous","continuous","discrete","continuous","continuous"
+  )
+  expect_equal(.check_hierfamily_rel(split_hierarchy.res, distr, debug = TRUE), -1)
+
+  distr = list(
+    "discrete",
+    "continuous", "continuous","continuous",
+    "discrete","discrete","discrete","discrete","discrete","discrete"
+  )
+  expect_equal(.check_hierfamily_rel(split_hierarchy.res, distr, debug = TRUE), 0)
+
+  distr = list(
+    "continuous",
+    "continuous", "continuous","continuous",
+    "discrete","discrete","discrete","discrete","discrete","discrete"
+  )
+  expect_equal(.check_hierfamily_rel(split_hierarchy.res, distr, debug = TRUE), 0)
+
+  distr = list(
+    "gaussian",
+    "continuous", "continuous","continuous",
+    "discrete","discrete","discrete","discrete","discrete","discrete"
+  )
+  expect_equal(.check_hierfamily_rel(split_hierarchy.res, distr, debug = TRUE), 0)
+
+  distr = list(
+    "gaussian",
+    "gaussian", "gaussian","gaussian",
+    "nbinom","poisson","poisson","nbinom","nbinom","nbinom"
+  )
+  expect_equal(.check_hierfamily_rel(split_hierarchy.res, distr, debug = TRUE), 0)
+
+  distr = list(
+    "gaussian",
+    "gaussian", "gaussian","nbinom",
+    "nbinom","poisson","poisson","nbinom","nbinom","nbinom"
+  )
+  expect_equal(.check_hierfamily_rel(split_hierarchy.res, distr, debug = TRUE), 0)
+
+  distr = list(
+    "gaussian",
+    "gaussian", "gaussian","nbinom",
+    "nbinom","poisson","poisson","nbinom","gaussian","nbinom"
+  )
+  expect_equal(.check_hierfamily_rel(split_hierarchy.res, distr, debug = TRUE), -1)
+
+  distr = list(
+    "gaussian",
+    "gaussian", "gaussian","nbinom",
+    "nbinom","poisson","poisson","nbinom","continuous","nbinom"
+  )
+  expect_equal(.check_hierfamily_rel(split_hierarchy.res, distr, debug = TRUE), -1)
+})