Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Fix tolerance values #18

Merged
merged 2 commits into from
Oct 25, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
30 changes: 15 additions & 15 deletions tests/testthat/test-reconc_MixCond.R
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
test_that("reconc_MixCond simple example", {
# Simple example with

# Simple example with
# - 12 bottom
# - 10 upper: year, 6 bi-monthly, 3 quarterly
A <- matrix(data=c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
Expand All @@ -14,43 +14,43 @@ test_that("reconc_MixCond simple example", {
0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1),
nrow=10,byrow = TRUE)

# Define means and vars for the forecasts
means <- c(90,62,63,64,31,32,31,33,31,32,rep(15,12))
vars <- c(20,8,8,8,4,4,4,4,4,4,rep(2,12))^2

# create the lists for reconciliation
## upper
## upper
fc_upper <- list(mu = means[1:10],
Sigma = diag(vars[1:10]))

## bottom
fc_bottom <- list()
for(i in seq(ncol(A))){
fc_bottom[[i]] <-as.integer(.distr_sample(list(mean=means[i+10],sd = vars[i+10]), "gaussian", 2e4))
fc_bottom[[i]][which(fc_bottom[[i]]<0)] <- 0 # set-negative-to-zero
}


res.MixCond <- reconc_MixCond(A,fc_bottom,fc_upper,bottom_in_type = "samples",seed=42)

bott_rec_means <- unlist(lapply(res.MixCond$bottom_reconciled$pmf,PMF.get_mean))
bott_rec_vars <- unlist(lapply(res.MixCond$bottom_reconciled$pmf,PMF.get_var))


# Create PMF from samples
fc_bottom_pmf <- list()
for(i in seq(ncol(A))){
fc_bottom_pmf[[i]] <-PMF.from_samples(fc_bottom[[i]])
}

# Reconcile from bottom PMF
res.MixCond_pmf <- reconc_MixCond(A,fc_bottom_pmf,fc_upper,seed=42)

bott_rec_means_pmf <- unlist(lapply(res.MixCond_pmf$bottom_reconciled$pmf,PMF.get_mean))
bott_rec_vars_pmf <- unlist(lapply(res.MixCond_pmf$bottom_reconciled$pmf,PMF.get_var))

expect_equal(bott_rec_means,bott_rec_means_pmf,tolerance = "3e")
expect_equal(bott_rec_vars,bott_rec_vars_pmf,tolerance = "3e")
expect_equal(bott_rec_means,bott_rec_means_pmf, tolerance = 0.1)
expect_equal(bott_rec_vars,bott_rec_vars_pmf, tolerance = 0.1)

})
68 changes: 34 additions & 34 deletions tests/testthat/test-sample_funs.R
Original file line number Diff line number Diff line change
@@ -1,84 +1,84 @@
test_that("sampling from univariate normal", {

# Generate 1e4 samples from univariate Gaussian
params <- list(mean=42, sd=1)
distr <- "gaussian"
n <- 1e4
samples <- .distr_sample(params, distr, n)
# Compute empirical mean and sd

# Compute empirical mean and sd
sam_mean <- mean(samples)
sam_sd <- sd(samples)

# Check how close empirical values are to the truth
m <- abs(sam_mean-42)/42
s <- abs(sam_sd-1)

expect_equal(m < 2e-3, TRUE)
expect_equal(s < 4e-2, TRUE)
})

test_that("sampling from univariate nbinom", {

# Generate 1e4 samples from negative binomial (size, prob)
params <- list(size=12,prob=0.8)
distr <- "nbinom"
n <- 1e4
samples <- .distr_sample(params, distr, n)

# Compute empirical mean
sam_mean <- mean(samples)
true_mean <- params$size*(1-params$prob)/params$prob

# Check how close empirical values are to the truth
m <- abs(sam_mean-true_mean)/true_mean

expect_equal(m < 3e-2, TRUE)

# Generate 1e4 samples from negative binomial (size, mu)
params <- list(size=12,mu=true_mean)
distr <- "nbinom"
n <- 1e4
samples <- .distr_sample(params, distr, n)

# Compute empirical mean
sam_mean <- mean(samples)

# Check how close empirical values are to the truth
m <- abs(sam_mean-params$mu)/params$mu

expect_equal(m < 3e-2, TRUE)

# Check if it returns an error when all 3 parameters are specified
params <- list(size=12,mu=true_mean,prob=0.8)
distr <- "nbinom"
n <- 1e4
expect_error(.distr_sample(params, distr, n))

# Check if it returns an error when size is not specified
params <- list(mu=true_mean,prob=0.8)
distr <- "nbinom"
n <- 1e4
expect_error(.distr_sample(params, distr, n))



})

test_that("sampling from univariate poisson", {

# Generate 1e4 samples from poisson
params <- list(lambda=10)
distr <- "poisson"
n <- 1e4
samples <- .distr_sample(params, distr, n)

# Compute empirical mean
sam_mean <- mean(samples)

# Check how close empirical values are to the truth
m <- abs(sam_mean-10)/10

expect_equal(m < 3e-2, TRUE)
})

Expand All @@ -89,43 +89,43 @@ test_that("sampling from multivariate normal", {
Sigma= matrix(c(1,0.7,0.7,1),nrow = 2)
n <- 1e4
samples <- .MVN_sample(n, mu, Sigma)

# Compute empirical mean
sam_mean <- colMeans(samples)

# Check how close empirical values are to the truth
m <- abs(sam_mean-10)/10

expect_equal(all(m < 8e-3), TRUE)
})

test_that("MVN density works", {

# Create 3x3 covariance matrix
L <- matrix(0,nrow=3,ncol=3)
L[lower.tri(L,diag=TRUE)] <- c(0.9,0.8,0.5,0.9,0.2,0.6)
Sigma <- L%*%t(L)

# create mean vector
mu <- c(0,1,-1)

# matrix where to evaluate the MVN
xx <- matrix(c(0,2,1,
2,3,4,
0.5,0.5,0.5,
0,1,-1), ncol=3,byrow=TRUE)

res <- .MVN_density(x=xx,mu=mu,Sigma=Sigma)

true_val <- c(8.742644e-04, 1.375497e-11, 3.739985e-03, 1.306453e-01)
expect_equal(res,true_val,tolerance = "3e")
expect_equal(res,true_val,tolerance = 0.1)

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

res_chuncks <- .MVN_density(x=xx,mu=mu,Sigma=Sigma)
res_all <- .MVN_density(x=xx,mu=mu,Sigma=Sigma,max_size_x = 1e4)

expect_equal(res_chuncks,res_all)

})
Loading