R Under development (unstable) (2024-08-21 r87038 ucrt) -- "Unsuffered Consequences" Copyright (C) 2024 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > library(testthat) > Sys.setenv('OMP_THREAD_LIMIT'=2) > library(rlibkriging) Attaching package: 'rlibkriging' The following objects are masked from 'package:base': load, save > > for (kernel in c("gauss","exp")) { + # kernel = "gauss" + context(paste0("Check LogLikelihood for kernel ",kernel)) + + f <- function(X) apply(X, 1, function(x) prod(sin((x-.5)^2))) + n <- 10 + set.seed(123) + X <- cbind(runif(n),runif(n),runif(n)) + y <- f(X) + d = ncol(X) + + k = DiceKriging::km(design=X,response=y,covtype = kernel,control = list(trace=F)) + ll = function(theta) DiceKriging::leaveOneOutFun(theta,k) + + r <- Kriging(y, X, kernel) + ll2 = function(theta) leaveOneOutFun(r,theta) + + precision <- 1e-8 # the following tests should work with it, since the computations are analytical + x=runif(d) + xenv=new.env() + test_that(desc="leaveOneOut is the same that DiceKriging one", + expect_equal(leaveOneOutFun(r,x)$leaveOneOut[1],DiceKriging::leaveOneOutFun(x,k,xenv),tolerance = precision)) + + test_that(desc="leaveOneOut Grad is the same that DiceKriging one", + expect_equal(t(leaveOneOutFun(r,x,return_grad=T)$leaveOneOutGrad),DiceKriging::leaveOneOutGrad(x,k,xenv),tolerance= precision)) + } Test passed 🥳 Test passed 🌈 Test passed 🥳 Test passed 🌈 > > proc.time() user system elapsed 1.92 0.28 2.14