Cleanup r tests (#246)

* fix & clean DiceKriging/rlibkriging test * cleanup tests * set chol warning
libKriging · Jan 12, 2023 · 95e066f · 95e066f
1 parent e8f010e
commit 95e066f
Show file tree

Hide file tree

Showing 28 changed files with 39 additions and 122 deletions.
diff --git a/bindings/R/rlibkriging/src/linalg.cpp b/bindings/R/rlibkriging/src/linalg.cpp
@@ -27,3 +27,10 @@ arma::mat linalg_chol_safe(arma::mat X) {
   Rcpp::XPtr<LinearAlgebra> impl_ptr(la);
   return impl_ptr->safe_chol_lower(X);
 }
+
+// [[Rcpp::export]]
+void linalg_set_chol_warning(bool warn) {
+  LinearAlgebra* la = new LinearAlgebra();
+  Rcpp::XPtr<LinearAlgebra> impl_ptr(la);
+  impl_ptr->set_chol_warning(warn);
+}
diff --git a/bindings/R/rlibkriging/tests/testthat.R b/bindings/R/rlibkriging/tests/testthat.R
@@ -1,5 +1,7 @@
 ## load dependencies
 library(testthat)
+library(rlibkriging)
+#library(rlibkriging, lib.loc="bindings/R/Rlibs")
 
 ## test package
 test_check('rlibkriging')
diff --git a/bindings/R/rlibkriging/tests/testthat/test-KrigingCholCrash.R b/bindings/R/rlibkriging/tests/testthat/test-KrigingCholCrash.R
@@ -1,7 +1,5 @@
-library(testthat)
-#library(rlibkriging, lib.loc="bindings/R/Rlibs")
-#packageDescription("rlibkriging")
 rlibkriging:::linalg_set_num_nugget(1E-10)
+rlibkriging:::linalg_set_chol_warning(TRUE)
 default_nugget = rlibkriging:::linalg_get_num_nugget()
 
 #############################################################

diff --git a/bindings/R/rlibkriging/tests/testthat/test-KrigingFit.R b/bindings/R/rlibkriging/tests/testthat/test-KrigingFit.R
@@ -1,9 +1,3 @@
-library(testthat)
-#library(rlibkriging, lib.loc="bindings/R/Rlibs")
-#rlibkriging:::optim_log(2)
-#rlibkriging:::optim_use_reparametrize(FALSE)
-#rlibkriging:::optim_set_theta_lower_factor(0.02)
-
 context("Fit: 1D")
 
 f = function(x) 1-1/2*(sin(12*x)/(1+x)+2*cos(7*x)*x^5+0.7)

diff --git a/bindings/R/rlibkriging/tests/testthat/test-KrigingLeaveOneOut.R b/bindings/R/rlibkriging/tests/testthat/test-KrigingLeaveOneOut.R
@@ -1,5 +1,3 @@
-library(testthat)
-
 for (kernel in c("gauss","exp","matern3_2","matern5_2")) {
 # kernel = "gauss"
   context(paste0("Check LogLikelihood for kernel ",kernel))

diff --git a/bindings/R/rlibkriging/tests/testthat/test-KrigingLeaveOneOut_3d.R b/bindings/R/rlibkriging/tests/testthat/test-KrigingLeaveOneOut_3d.R
@@ -1,5 +1,3 @@
-library(testthat)
-
 for (kernel in c("gauss","exp")) {
 # kernel = "gauss"
   context(paste0("Check LogLikelihood for kernel ",kernel))

diff --git a/bindings/R/rlibkriging/tests/testthat/test-KrigingLogLik.R b/bindings/R/rlibkriging/tests/testthat/test-KrigingLogLik.R
@@ -1,7 +1,3 @@
-#install.packages("bindings/R/rlibkriging_0.3-2_R_x86_64-pc-linux-gnu.tar.gz")
-
-library(testthat)
-
 for (kernel in c("exp","matern3_2","matern5_2","gauss")) {
   context(paste0("Check LogLikelihood for kernel ",kernel))
 
@@ -47,8 +43,6 @@ for (kernel in c("exp","matern3_2","matern5_2","gauss")) {
 
 ########################## 2D
 
-
-
 for (kernel in c("matern3_2","matern5_2","gauss","exp")) {
   context(paste0("Check LogLikelihood for kernel ",kernel))
 

diff --git a/bindings/R/rlibkriging/tests/testthat/test-KrigingLogLikGradHess.R b/bindings/R/rlibkriging/tests/testthat/test-KrigingLogLikGradHess.R
@@ -1,5 +1,3 @@
-library(testthat)
-
 #kernel="matern3_2" #
 for (kernel in c("gauss","exp")){ # NOT YET WORKING: ,"matern3_2","matern5_2")) {
   context(paste0("Check LogLikelihood for kernel ",kernel))

diff --git a/bindings/R/rlibkriging/tests/testthat/test-KrigingLogMargPost.R b/bindings/R/rlibkriging/tests/testthat/test-KrigingLogMargPost.R
@@ -1,5 +1,3 @@
-library(testthat)
-
 kernel_type = function(kernel) {
   if (kernel=="matern3_2") return("matern_3_2")
   if (kernel=="matern5_2") return("matern_5_2")

diff --git a/bindings/R/rlibkriging/tests/testthat/test-KrigingMethods.R b/bindings/R/rlibkriging/tests/testthat/test-KrigingMethods.R
@@ -1,8 +1,3 @@
-library(testthat)
-
-# install.packages("../rlib0.1-10_R_x86_64-pc-linux-gnu.tar.gz",repos=NULL)
-library(rlibkriging)
-
 # f <- function(X) apply(X, 1, function(x) prod(sin((x-.5)^2)))
 f <- function(X) apply(X, 1, function(x)
   prod(sin(2*pi*( x * (seq(0,1,l=1+length(x))[-1])^2 )))

diff --git a/bindings/R/rlibkriging/tests/testthat/test-KrigingPredict.R b/bindings/R/rlibkriging/tests/testthat/test-KrigingPredict.R
@@ -1,7 +1,3 @@
-library(testthat)
-#library(rlibkriging, lib.loc="bindings/R/Rlibs")
-
-
 context("Check predict args (T,F) are consistent")
 
 f = function(x) 1-1/2*(sin(12*x)/(1+x)+2*cos(7*x)*x^5+0.7)

diff --git a/bindings/R/rlibkriging/tests/testthat/test-NoiseKrigingFit.R b/bindings/R/rlibkriging/tests/testthat/test-NoiseKrigingFit.R
@@ -1,7 +1,3 @@
-library(testthat)
-#library(rlibkriging, lib.loc="bindings/R/Rlibs")
-#rlibkriging:::optim_log(3)
-
 context("Fit: 1D")
 
 f = function(x) 1-1/2*(sin(12*x)/(1+x)+2*cos(7*x)*x^5+0.7)

diff --git a/bindings/R/rlibkriging/tests/testthat/test-NoiseKrigingLogLik.R b/bindings/R/rlibkriging/tests/testthat/test-NoiseKrigingLogLik.R
@@ -1,7 +1,3 @@
-#install.packages("bindings/R/rlibkriging_0.3-2_R_x86_64-pc-linux-gnu.tar.gz")
-
-library(testthat)
-
 for (kernel in c("exp","matern3_2","matern5_2","gauss")) {
   context(paste0("Check LogLikelihood for kernel ",kernel))
 

diff --git a/bindings/R/rlibkriging/tests/testthat/test-NoiseKrigingMethods.R b/bindings/R/rlibkriging/tests/testthat/test-NoiseKrigingMethods.R
@@ -1,9 +1,3 @@
-library(testthat)
-
-library(rlibkriging, lib.loc="bindings/R/Rlibs")
-# install.packages("../rlib0.1-10_R_x86_64-pc-linux-gnu.tar.gz",repos=NULL)
-#library(rlibkriging)
-
 # f <- function(X) apply(X, 1, function(x) prod(sin((x-.5)^2)))
 f <- function(X) apply(X, 1, function(x)
   prod(sin(2*pi*( x * (seq(0,1,l=1+length(x))[-1])^2 )))

diff --git a/bindings/R/rlibkriging/tests/testthat/test-NoiseKrigingPredict.R b/bindings/R/rlibkriging/tests/testthat/test-NoiseKrigingPredict.R
@@ -1,6 +1,3 @@
-library(testthat)
-#library(rlibkriging, lib.loc="bindings/R/Rlibs")
-
 for (kernel in c("gauss","exp","matern3_2","matern5_2")) {
   context(paste0("Check predict 1D for kernel ",kernel))
 

diff --git a/bindings/R/rlibkriging/tests/testthat/test-NuggetKrigingFit.R b/bindings/R/rlibkriging/tests/testthat/test-NuggetKrigingFit.R
@@ -1,7 +1,3 @@
-library(testthat)
-#library(rlibkriging, lib.loc="bindings/R/Rlibs")
-#rlibkriging:::optim_log(3)
-
 context("Fit: 1D")
 
 f = function(x) 1-1/2*(sin(12*x)/(1+x)+2*cos(7*x)*x^5+0.7)

diff --git a/bindings/R/rlibkriging/tests/testthat/test-NuggetKrigingLogLik.R b/bindings/R/rlibkriging/tests/testthat/test-NuggetKrigingLogLik.R
@@ -1,7 +1,3 @@
-library(testthat)
-#library(rlibkriging, lib.loc="bindings/R/Rlibs")
-#rlibkriging:::optim_log(3)
-
 kernel="gauss"
 for (kernel in c("exp","matern3_2","matern5_2","gauss")) {
   context(paste0("Check LogLikelihood for kernel ",kernel))

diff --git a/bindings/R/rlibkriging/tests/testthat/test-NuggetKrigingLogMargPost.R b/bindings/R/rlibkriging/tests/testthat/test-NuggetKrigingLogMargPost.R
@@ -1,7 +1,3 @@
-library(testthat)
-#library(rlibkriging, lib.loc="bindings/R/Rlibs")
-#rlibkriging:::optim_log(3)
-
 kernel="gauss"
 for (kernel in c("exp","matern3_2","matern5_2","gauss")) {
   context(paste0("Check logMargPost for kernel ",kernel))

diff --git a/bindings/R/rlibkriging/tests/testthat/test-NuggetKrigingMethods.R b/bindings/R/rlibkriging/tests/testthat/test-NuggetKrigingMethods.R
@@ -1,8 +1,3 @@
-library(testthat)
-
-# install.packages("../rlib0.1-10_R_x86_64-pc-linux-gnu.tar.gz",repos=NULL)
-#library(rlibkriging)
-
 # f <- function(X) apply(X, 1, function(x) prod(sin((x-.5)^2)))
 f <- function(X) apply(X, 1, function(x)
   prod(sin(2*pi*( x * (seq(0,1,l=1+length(x))[-1])^2 )))

diff --git a/bindings/R/rlibkriging/tests/testthat/test-NuggetKrigingPredict.R b/bindings/R/rlibkriging/tests/testthat/test-NuggetKrigingPredict.R
@@ -1,6 +1,3 @@
-library(testthat)
-#library(rlibkriging, lib.loc="bindings/R/Rlibs")
-
 for (kernel in c("gauss","exp","matern3_2","matern5_2")) {
   context(paste0("Check predict 1D for kernel ",kernel))
 

diff --git a/bindings/R/rlibkriging/tests/testthat/test-RobustGaSP-Nugget.R b/bindings/R/rlibkriging/tests/testthat/test-RobustGaSP-Nugget.R
@@ -1,5 +1,3 @@
-library(testthat)
-
 library(RobustGaSP)
 
 context("RobustGaSP-Nugget / Fit: 1D")

diff --git a/bindings/R/rlibkriging/tests/testthat/test-RobustGaSP.R b/bindings/R/rlibkriging/tests/testthat/test-RobustGaSP.R
@@ -1,5 +1,3 @@
-library(testthat)
-
 library(RobustGaSP)
 
 context("RobustGaSP / Fit: 1D")

diff --git a/bindings/R/rlibkriging/tests/testthat/test-asDiceKriging.R b/bindings/R/rlibkriging/tests/testthat/test-asDiceKriging.R
@@ -1,9 +1,3 @@
-library(testthat)
-#library(rlibkriging, lib.loc="bindings/R/Rlibs")
-
-## install.packages("../rlibkriging_0.1-10_R_x86_64-pc-linux-gnu.tar.gz",repos=NULL)
-## library(rlibkriging)
-##
 ## Changes by Yves remove the references to the packages as in 'rlibkriging::simulate',
 ## because simulate is not exported as such from rlibkriging
 
@@ -18,13 +12,11 @@ X <- cbind(runif(n))
 y <- f(X)
 d <- ncol(X)
 
-library(DiceKriging)
 ## kriging model 1 : matern5_2 covariance structure, no trend, no nugget effect
-km1 <- km(design = X, response = y, covtype = "gauss",
+km1 <- DiceKriging::km(design = X, response = y, covtype = "gauss",
          formula = ~1, estim.method = "LOO",
          parinit = c(.15), control = list(trace = FALSE))
-library(rlibkriging)
-KM1 <- KM(design = X, response = y, covtype = "gauss",
+KM1 <- rlibkriging::KM(design = X, response = y, covtype = "gauss",
           formula = ~1, estim.method = "LOO",
           parinit = c(.15))
 
@@ -39,20 +31,14 @@ test_that("m1.argmax(loo) == KM1.argmax(loo)",
 
 plot(Vectorize(function(.t) DiceKriging::leaveOneOutFun(param = as.numeric(.t), model = km1)))
 abline(v = km1@covariance@range.val)
-plot(Vectorize(function(.t) leaveOneOutFun(KM1@Kriging, as.numeric(.t))),
+plot(Vectorize(function(.t) rlibkriging::leaveOneOutFun(KM1@Kriging, as.numeric(.t))),
      add = TRUE, col = 'red')
 abline(v = KM1@covariance@range.val, col = 'red')
 
 
 
 ##########################################################################
 
-library(testthat)
-
-## install.packages("../rlibkriging_0.1-10_R_x86_64-pc-linux-gnu.tar.gz",
-##                  repos = NULL)
-## library(rlibkriging)
-
 context("# A 2D example - Branin-Hoo function")
 
 branin <- function (x) {
@@ -66,18 +52,18 @@ branin <- function (x) {
 d <- 2; n <- 16
 design.fact <- expand.grid(x1 = seq(0, 1, length.out = 4),
                            x2 = seq(0, 1, length.out = 4))
-y <- apply(design.fact, 1, branin) 
+y <- apply(design.fact, 1, DiceKriging::branin) 
 
 library(DiceKriging)
 ## kriging model 1 : matern5_2 covariance structure, no trend, no nugget effect
-km1 <- km(design = design.fact, response = y, covtype = "gauss",
+km1 <- DiceKriging::km(design = design.fact, response = y, covtype = "gauss",
           parinit = c(.5, 1), control = list(trace = FALSE))
-KM1 <- KM(design = design.fact, response = y, covtype = "gauss",
+KM1 <- rlibkriging::KM(design = design.fact, response = y, covtype = "gauss",
           parinit = c(.5, 1))
 
 test_that("m1.logLikFun == as_m1.logLikFun",
-          expect_true(logLikFun(km1@covariance@range.val, km1) ==
-                      logLikFun(km1@covariance@range.val, KM1)))
+          expect_true(DiceKriging::logLikFun(km1@covariance@range.val, km1) ==
+                      DiceKriging::logLikFun(km1@covariance@range.val, KM1)))
 
 test_that("m1.argmax(logLig) == as_m1.argmax(logLig)", 
           expect_equal(km1@covariance@range.val,
@@ -86,11 +72,11 @@ test_that("m1.argmax(logLig) == as_m1.argmax(logLig)",
 
 ll <- function(Theta){
     apply(Theta, 1,
-          function(theta) logLikFun(theta, km1))
+          function(theta) DiceKriging::logLikFun(theta, km1))
 }
 as_ll <- function(Theta){
     apply(Theta, 1,
-          function(theta) logLikelihoodFun(KM1@Kriging, theta)$logLikelihood[1])
+          function(theta) rlibkriging::logLikelihoodFun(KM1@Kriging, theta)$logLikelihood[1])
 }
 t <- seq(from = 0.01, to = 2, length.out = 51)
 ttg <- expand.grid(t, t)
@@ -105,10 +91,10 @@ points(KM1@covariance@range.val[1],
        KM1@covariance@range.val[2],
        col = 'red')
 
-pred <- predict(km1,
+pred <- DiceKriging::predict(km1,
                 newdata = matrix(.5, ncol = 2), type = "UK",
                 checkNames = FALSE, light.return = TRUE)
-Pred <- predict(KM1,
+Pred <- DiceKriging::predict(KM1,
                 newdata = matrix(.5, ncol = 2), type = "UK",
                 checkNames = FALSE, light.return = TRUE)
 
@@ -198,16 +184,16 @@ x <- matrix(x,ncol=d)
 test_that("Consitency of 'DiceKriging' and 'rlibkriging' 'predict' methods",
           expect_equal(DiceKriging::predict(km2,newdata = x, type = "UK",
                                             checkNames = FALSE)$mean[1],
-                       predict(KM2, newdata = x, type = "UK")$mean[1],
+                       DiceKriging::predict(KM2, newdata = x, type = "UK")$mean[1],
                        tol = 0.01))
 
 x <- matrix(X[2, ], ncol = d) + 0.001
 n <-  1000
 set.seed(123)
-sims_km2 <- simulate(km2, nsim = n,newdata = x,
+sims_km2 <- DiceKriging::simulate(km2, nsim = n,newdata = x,
                      checkNames = FALSE, cond = TRUE,
                      nugget.sim=1e-10)
-sims_KM2 <- simulate(KM2, nsim = n, newdata = x,
+sims_KM2 <- DiceKriging::simulate(KM2, nsim = n, newdata = x,
                      checkNames = FALSE , cond = TRUE)
 t <- t.test(sims_km2, sims_KM2, var.equal = FALSE)
 
@@ -216,11 +202,11 @@ if (t$p.value < 0.05) {
     points(X, y)
     xx <-  seq(from = 0, to = 1, length.out = 101)
     for (i in 1:100) {
-        lines(xx, simulate(km2, nsim = 1, newdata = xx,
+        lines(xx, DiceKriging::simulate(km2, nsim = 1, newdata = xx,
                            checkNames = FALSE, cond = TRUE,
                            nugget.sim = 1e-10),
               col = rgb(0, 0, 1, 0.02))
-        lines(xx, simulate(KM2, nsim = 1, newdata = xx,
+        lines(xx, DiceKriging::simulate(KM2, nsim = 1, newdata = xx,
                            checkNames = FALSE, cond=TRUE,
                            nugget.sim = 0),
               col = rgb(1, 0, 0, 0.02))
@@ -253,11 +239,11 @@ test_args <-  function(formula, design, response ,covtype, estim.method ) {
     set.seed(123)
 
   parinit <- runif(ncol(design))
-    k <<- km(formula = formula, design = design,
+    k <<- DiceKriging::km(formula = formula, design = design,
              response = response, covtype = covtype,
              estim.method = estim.method,
              parinit = parinit, control = list(trace = FALSE))
-    as_k <<- KM(formula = formula, design = design,
+    as_k <<- rlibkriging::KM(formula = formula, design = design,
                 response = response, covtype = covtype,
                 estim.method = estim.method,
                 parinit = parinit)
@@ -291,15 +277,15 @@ test_args <-  function(formula, design, response ,covtype, estim.method ) {
     test_that("DiceKriging::predict == rlibkriging::predict",
               expect_equal(DiceKriging::predict(km2, newdata = x, type = "UK",
                                                 checkNames = FALSE)$mean[1],
-                           predict(KM2, newdata = x, type = "UK")$mean[1],
+                           DiceKriging::predict(KM2, newdata = x, type = "UK")$mean[1],
                            tol = 0.01))
 
     n <- 1000
     set.seed(123)
-    sims_km2 <<- simulate(km2, nsim = n, newdata = x,
+    sims_km2 <<- DiceKriging::simulate(km2, nsim = n, newdata = x,
                           checkNames = FALSE, cond = TRUE,
                           nugget.sim = 1e-10)
-    sims_KM2 <<- simulate(KM2, nsim = n,newdata = x,
+    sims_KM2 <<- DiceKriging::simulate(KM2, nsim = n,newdata = x,
                           checkNames = FALSE, cond = TRUE)
     t = t.test(t(sims_km2), sims_KM2, var.equal = FALSE , paired = FALSE)
     print(t)

diff --git a/bindings/R/rlibkriging/tests/testthat/test-binding-consistency.R b/bindings/R/rlibkriging/tests/testthat/test-binding-consistency.R
@@ -34,9 +34,6 @@ find_dir = function() {
   }
 }
 
-#library(testthat)
-#library(rlibkriging, lib = "/Users/pascal/haveneer/libKriging.perso/bindings/R/Rlibs")
-
 refpath = find_dir()
 print(paste0("Reference directory=", refpath))
 prefix = "data1-scal"

diff --git a/bindings/R/rlibkriging/tests/testthat/test-normalize.R b/bindings/R/rlibkriging/tests/testthat/test-normalize.R
@@ -1,10 +1,3 @@
-library(testthat)
-#library(rlibkriging, lib.loc="bindings/R/Rlibs")
-#rlibkriging:::optim_log(2)
-#rlibkriging:::optim_use_reparametrize(FALSE)
-#rlibkriging:::optim_set_theta_lower_factor(0.02)
-
-
 f = function(x) 1-1/2*(sin(12*x)/(1+x)+2*cos(7*x)*x^5+0.7)
 n <- 5
 set.seed(123)

diff --git a/bindings/R/rlibkriging/tests/testthat/test-rlibkriging-demo.R b/bindings/R/rlibkriging/tests/testthat/test-rlibkriging-demo.R
@@ -1,6 +1,3 @@
-# install.packages('Rcpp', repos='http://cran.irsn.fr/')
-# install.packages('rlibkriging-version.tgz', repos=NULL)
-
 X <- as.matrix(c(0.0, 0.2, 0.5, 0.8, 1.0))
 f <- function(x) 1 - 1 / 2 * (sin(12 * x) / (1 + x) + 2 * cos(7 * x) * x^5 + 0.7)
 y <- f(X)

diff --git a/src/lib/LinearAlgebra.cpp b/src/lib/LinearAlgebra.cpp
@@ -27,6 +27,11 @@ LIBKRIGING_EXPORT arma::mat LinearAlgebra::safe_chol_lower(arma::mat X) {
 }
 
 bool LinearAlgebra::warn_chol = false;
+
+LIBKRIGING_EXPORT void LinearAlgebra::set_chol_warning(bool warn) {
+  LinearAlgebra::warn_chol = warn;
+};
+
 int LinearAlgebra::max_inc_choldiag = 10;
 
 // Recursive turn-around for ill-condition of correlation matrix. Used in *Kriging::fit & *Kriging::simulate

diff --git a/src/lib/include/libKriging/LinearAlgebra.hpp b/src/lib/include/libKriging/LinearAlgebra.hpp
@@ -14,6 +14,8 @@ class LinearAlgebra {
   LIBKRIGING_EXPORT static double get_num_nugget();
 
   static bool warn_chol;
+  LIBKRIGING_EXPORT static void set_chol_warning(bool warn);
+
   static int max_inc_choldiag;
   LIBKRIGING_EXPORT static arma::mat safe_chol_lower(arma::mat X);
   static arma::mat safe_chol_lower(arma::mat X, int warn);