From cc6354fc97e96d0605a9f96d5db7676f13b94423 Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Thu, 24 Oct 2024 08:03:54 -0500 Subject: [PATCH] Fix tolerance values "3e" was never really a supported value but somehow managed to work. Now waldo actually complains about it. --- tests/testthat/test-reconc_MixCond.R | 30 ++++++------ tests/testthat/test-sample_funs.R | 68 ++++++++++++++-------------- 2 files changed, 49 insertions(+), 49 deletions(-) diff --git a/tests/testthat/test-reconc_MixCond.R b/tests/testthat/test-reconc_MixCond.R index cbd058a..6a501e2 100644 --- a/tests/testthat/test-reconc_MixCond.R +++ b/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) }) diff --git a/tests/testthat/test-sample_funs.R b/tests/testthat/test-sample_funs.R index f465270..553cc71 100644 --- a/tests/testthat/test-sample_funs.R +++ b/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) - + })