Skip to content

Commit

Permalink
Merge pull request #18 from hadley/dev-waldo
Browse files Browse the repository at this point in the history
Fix tolerance values
  • Loading branch information
dazzimonti authored Oct 25, 2024
2 parents 013042b + b88ff04 commit d228cd7
Show file tree
Hide file tree
Showing 2 changed files with 49 additions and 49 deletions.
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)

})

0 comments on commit d228cd7

Please sign in to comment.