Merge pull request #18 from hadley/dev-waldo

Fix tolerance values

Author: dazzimonti

tests/testthat/test-reconc_MixCond.R

@@ -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,
@@ -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)
 
 })

tests/testthat/test-sample_funs.R

@@ -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)
 })
 
@@ -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)
-  
+
 })