Skip to content

Commit b6f8720

Browse files
committed
Fixed tolerances in the tests, added tests on TDcond, mixCond and BUIS to cover cases not covered. Added yaml file and GitHub action for coverage calculation.
1 parent d228cd7 commit b6f8720

File tree

8 files changed

+302
-4
lines changed

8 files changed

+302
-4
lines changed

.github/workflows/test-coverage.yaml

Lines changed: 61 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,61 @@
1+
# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples
2+
# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help
3+
on:
4+
push:
5+
branches: [main, master]
6+
pull_request:
7+
branches: [main, master]
8+
9+
name: test-coverage.yaml
10+
11+
permissions: read-all
12+
13+
jobs:
14+
test-coverage:
15+
runs-on: ubuntu-latest
16+
env:
17+
GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
18+
19+
steps:
20+
- uses: actions/checkout@v4
21+
22+
- uses: r-lib/actions/setup-r@v2
23+
with:
24+
use-public-rspm: true
25+
26+
- uses: r-lib/actions/setup-r-dependencies@v2
27+
with:
28+
extra-packages: any::covr, any::xml2
29+
needs: coverage
30+
31+
- name: Test coverage
32+
run: |
33+
cov <- covr::package_coverage(
34+
quiet = FALSE,
35+
clean = FALSE,
36+
install_path = file.path(normalizePath(Sys.getenv("RUNNER_TEMP"), winslash = "/"), "package")
37+
)
38+
covr::to_cobertura(cov)
39+
shell: Rscript {0}
40+
41+
- uses: codecov/codecov-action@v4
42+
with:
43+
fail_ci_if_error: ${{ github.event_name != 'pull_request' && true || false }}
44+
file: ./cobertura.xml
45+
plugin: noop
46+
disable_search: true
47+
token: ${{ secrets.CODECOV_TOKEN }}
48+
49+
- name: Show testthat output
50+
if: always()
51+
run: |
52+
## --------------------------------------------------------------------
53+
find '${{ runner.temp }}/package' -name 'testthat.Rout*' -exec cat '{}' \; || true
54+
shell: bash
55+
56+
- name: Upload test results
57+
if: failure()
58+
uses: actions/upload-artifact@v4
59+
with:
60+
name: coverage-test-failures
61+
path: ${{ runner.temp }}/package

README.Rmd

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -24,6 +24,7 @@ knitr::opts_chunk$set(
2424
[![](http://cranlogs.r-pkg.org/badges/grand-total/bayesRecon)](https://cran.r-project.org/package=bayesRecon)
2525
[![Lifecycle: experimental](https://img.shields.io/badge/lifecycle-experimental-orange.svg)](https://lifecycle.r-lib.org/articles/stages.html#experimental)
2626
[![License: LGPL (>= 3)](https://img.shields.io/badge/license-LGPL (>= 3)-yellow.svg)](https://www.gnu.org/licences/lgpl-3.0)
27+
[![Codecov test coverage](https://codecov.io/gh/IDSIA/bayesRecon/graph/badge.svg)](https://app.codecov.io/gh/IDSIA/bayesRecon)
2728
<!-- badges: end -->
2829

2930
The package `bayesRecon` implements several methods for probabilistic reconciliation of hierarchical time series forecasts.

README.md

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -16,6 +16,8 @@ status](https://www.r-pkg.org/badges/version/bayesRecon)](https://CRAN.R-project
1616
experimental](https://img.shields.io/badge/lifecycle-experimental-orange.svg)](https://lifecycle.r-lib.org/articles/stages.html#experimental)
1717
[![License: LGPL (\>=
1818
3)](https://img.shields.io/badge/license-LGPL%20(%3E=%203)-yellow.svg)](https://www.gnu.org/licences/lgpl-3.0)
19+
[![Codecov test
20+
coverage](https://codecov.io/gh/IDSIA/bayesRecon/graph/badge.svg)](https://app.codecov.io/gh/IDSIA/bayesRecon)
1921
<!-- badges: end -->
2022

2123
The package `bayesRecon` implements several methods for probabilistic
Lines changed: 120 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,120 @@
1+
4
2+
4
3+
1
4+
3
5+
2
6+
2
7+
3
8+
0
9+
2
10+
3
11+
2
12+
3
13+
4
14+
1
15+
2
16+
4
17+
5
18+
0
19+
2
20+
2
21+
4
22+
1
23+
6
24+
4
25+
0
26+
2
27+
1
28+
4
29+
2
30+
3
31+
3
32+
3
33+
1
34+
3
35+
0
36+
3
37+
0
38+
1
39+
4
40+
2
41+
1
42+
2
43+
0
44+
5
45+
2
46+
5
47+
4
48+
2
49+
5
50+
2
51+
1
52+
1
53+
1
54+
3
55+
0
56+
3
57+
3
58+
1
59+
1
60+
2
61+
2
62+
5
63+
3
64+
2
65+
3
66+
1
67+
1
68+
3
69+
3
70+
1
71+
0
72+
1
73+
1
74+
2
75+
1
76+
3
77+
0
78+
1
79+
2
80+
0
81+
2
82+
1
83+
1
84+
2
85+
3
86+
2
87+
1
88+
0
89+
0
90+
1
91+
2
92+
0
93+
1
94+
4
95+
4
96+
3
97+
1
98+
2
99+
3
100+
2
101+
2
102+
1
103+
1
104+
1
105+
4
106+
5
107+
3
108+
3
109+
2
110+
0
111+
2
112+
3
113+
3
114+
2
115+
2
116+
2
117+
0
118+
1
119+
2
120+
3
Lines changed: 12 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,12 @@
1+
# Generate the monthly count time series for the mixCond and TDcond tests
2+
# CHANGE THE WORKING DIRECTORY BEFORE RUNNING
3+
rm(list=ls())
4+
library(bayesRecon)
5+
6+
set.seed(42)
7+
vals <- stats::rpois(12*10,lambda = 2)
8+
9+
10+
write.table(vals,file="./Monthly-Count_ts.csv",row.names = FALSE,sep=',',
11+
col.names = FALSE,quote = FALSE)
12+

tests/testthat/test-reconc_BUIS_gaussian.R

Lines changed: 44 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -106,4 +106,48 @@ test_that("Monthly, in_type=='samples', distr='discrete'",{
106106
expect_equal(abs(m) < 1.5e-2, TRUE)
107107
})
108108

109+
test_that("Monthly simple, in_type=='params', distr='nbinom'",{
110+
111+
# Read samples from dataForTests (reproducibility)
112+
vals <- read.csv(file = "dataForTests/Monthly-Count_ts.csv", header = FALSE)
113+
114+
# Create a count time series with monthly observations for 10 years
115+
y <- ts(data=vals,frequency = 12)
116+
117+
# Create the aggregated yearly time series
118+
y_agg <- temporal_aggregation(y,agg_levels = c(1,12))
119+
120+
# We use a marginal forecast that computes for each month
121+
# the empirical mean and variance
122+
# the forecast is a negative binomial with those params
123+
fc_bottom <- list()
124+
for(i in seq(12)){
125+
mm <- mean(y_agg$`f=12`[seq(i,120,12)])
126+
vv <- max(var(y_agg$`f=12`[seq(i,120,12)]), mm+0.5)
127+
#cat("i: ",i, "mean: ",mm, "var: ",vv, "size: ",mm^2/(vv-mm), "prob: ",mm/vv, "\n")
128+
129+
fc_bottom[[i]] <- list(size=mm^2/(vv-mm),mu=mm)
130+
}
131+
132+
# We compute the empirical mean and variance of the yearly ts
133+
# we forecast with a negative binomial with those parameters
134+
mm <- mean(y_agg$`f=1`)
135+
vv <- var(y_agg$`f=1`)
136+
fc_upper <- list(size=mm^2/(vv-mm), prob= mm/vv)
137+
138+
# Obtain the aggregation matrix for this hierarchy
139+
rec_mat <- get_reconc_matrices(c(1,12),12)
140+
141+
base_forecasts = append(list(fc_upper),fc_bottom)
142+
res.buis_params = reconc_BUIS(rec_mat$A, base_forecasts, in_type = "params", distr = "nbinom", seed=42)
143+
144+
145+
fc_upper_gauss <- list(mu=mm, Sigma = matrix(vv))
146+
res.mixCond <- reconc_MixCond(rec_mat$A, fc_bottom, fc_upper_gauss, bottom_in_type = "params", distr = 'nbinom')
147+
upp_pmf <- PMF.from_samples(as.integer(res.buis_params$upper_reconciled_samples))
148+
149+
expect_equal(res.mixCond$upper_reconciled$pmf[[1]],upp_pmf,tolerance = 0.1)
150+
151+
})
152+
109153
##############################################################################

tests/testthat/test-reconc_MixCond.R

Lines changed: 60 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -23,7 +23,7 @@ test_that("reconc_MixCond simple example", {
2323
## upper
2424
fc_upper <- list(mu = means[1:10],
2525
Sigma = diag(vars[1:10]))
26-
26+
2727
## bottom
2828
fc_bottom <- list()
2929
for(i in seq(ncol(A))){
@@ -50,7 +50,65 @@ test_that("reconc_MixCond simple example", {
5050
bott_rec_means_pmf <- unlist(lapply(res.MixCond_pmf$bottom_reconciled$pmf,PMF.get_mean))
5151
bott_rec_vars_pmf <- unlist(lapply(res.MixCond_pmf$bottom_reconciled$pmf,PMF.get_var))
5252

53-
expect_equal(bott_rec_means,bott_rec_means_pmf, tolerance = 0.1)
53+
expect_equal(bott_rec_means,bott_rec_means_pmf, tolerance = 0.01)
5454
expect_equal(bott_rec_vars,bott_rec_vars_pmf, tolerance = 0.1)
55+
56+
})
57+
58+
test_that("reconc_MixCond and reconc_TDcond with temporal hier and params", {
59+
60+
61+
# Read samples from dataForTests (reproducibility)
62+
vals <- read.csv(file = "dataForTests/Monthly-Count_ts.csv", header = FALSE)
63+
64+
# Create a count time series with monthly observations for 10 years
65+
y <- ts(data=vals,frequency = 12)
66+
67+
# Create the aggregated yearly time series
68+
y_agg <- temporal_aggregation(y,agg_levels = c(1,12))
69+
70+
# We use a marginal forecast that computes for each month
71+
# the empirical mean and forecasts a Poisson with that value
72+
fc_bottom <- list()
73+
for(i in seq(12)){
74+
fc_bottom[[i]] <- list(lambda=mean(y_agg$`f=12`[seq(i,120,12)]))
75+
}
76+
77+
# We compute the empirical mean and variance of the yearly ts
78+
# we forecast with a Gaussian with those parameters
79+
fc_upper <- list(mu=mean(y_agg$`f=1`), Sigma=matrix(var(y_agg$`f=1`)))
80+
81+
# Obtain the aggregation matrix for this hierarchy
82+
rec_mat <- get_reconc_matrices(c(1,12),12)
83+
84+
# Do a couple of checks on S and A
85+
expect_no_error(.check_S(rec_mat$S))
86+
expect_error(.check_S(rec_mat$A))
87+
expect_true(.check_BU_matr(rec_mat$A))
88+
expect_false(.check_BU_matr(rec_mat$S))
89+
90+
# We can reconcile with reconc_MixCond
91+
res.mixCond <- reconc_MixCond(rec_mat$A, fc_bottom, fc_upper, bottom_in_type = "params", distr = 'poisson')
92+
93+
# We can reconcile with reconc_TDcond
94+
res.TDcond <- reconc_TDcond(rec_mat$A, fc_bottom, fc_upper, bottom_in_type = "params", distr = 'poisson')
95+
96+
# Summary of the upper reconciled with TDcond
97+
pmfSum <- PMF.summary(res.TDcond$upper_reconciled$pmf[[1]])
98+
# We expect that the reconciled mean is very similar to the initial mean (should be equal)
99+
expect_equal(pmfSum$Mean,fc_upper$mu,tolerance = 0.01)
100+
101+
# Check that all bottom and upper reconciled PMF sum to 1
102+
check_pmf_bott_mixCond <- sum(unlist(lapply(res.mixCond$bottom_reconciled$pmf, function(x){sum(x)})))
103+
check_pmf_upp_mixCond <- sum(unlist(lapply(res.mixCond$upper_reconciled$pmf, function(x){sum(x)})))
104+
expect_equal(check_pmf_bott_mixCond,12)
105+
expect_equal(check_pmf_upp_mixCond,1)
106+
107+
# Check that all bottom and upper reconciled PMF sum to 1
108+
check_pmf_bott_TDcond <- sum(unlist(lapply(res.TDcond$bottom_reconciled$pmf, function(x){sum(x)})))
109+
check_pmf_upp_TDcond <- sum(unlist(lapply(res.TDcond$upper_reconciled$pmf, function(x){sum(x)})))
110+
expect_equal(check_pmf_bott_TDcond,12)
111+
expect_equal(check_pmf_upp_TDcond,1)
55112

113+
56114
})

tests/testthat/test-sample_funs.R

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -114,11 +114,11 @@ test_that("MVN density works", {
114114
2,3,4,
115115
0.5,0.5,0.5,
116116
0,1,-1), ncol=3,byrow=TRUE)
117-
117+
118118
res <- .MVN_density(x=xx,mu=mu,Sigma=Sigma)
119119

120120
true_val <- c(8.742644e-04, 1.375497e-11, 3.739985e-03, 1.306453e-01)
121-
expect_equal(res,true_val,tolerance = 0.1)
121+
expect_equal(res,true_val, tolerance = 1e-6)
122122

123123
# Check if block-evaluation works
124124
xx <- matrix(runif(3*1e4),ncol=3,byrow=TRUE)

0 commit comments

Comments
 (0)