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 > > ##library(rlibkriging, lib.loc="bindings/R/Rlibs") > ##library(testthat) > > context("increment Kriging") > > f <- function(X) apply(X, 1, + function(x) + prod( + sin(2*pi* + ( x * (seq(0,1,l=1+length(x))[-1])^2 ) + ))) > n <- 1000 > d <- 3 > set.seed(1234) > X <- matrix(runif(n*d),ncol=d) > y <- f(X)+rnorm(1000,0,0.1) > r = NULL > try( r <- NoiseKriging(y, rep(0.1^2,nrow(X)), X, "gauss","constant",FALSE,"none","LL", parameters=list(theta = matrix(.5,ncol=3), sigma2 = 0.1, beta = matrix(0.01))) ) > > no = floor(n*0.7) > try( ro <- NoiseKriging(y[1:no], rep(0.1^2,no), X[1:no,], "gauss","constant",FALSE,"none","LL", parameters=list(theta = matrix(.5,ncol=3), sigma2 = 0.1, beta = matrix(0.01))) ) > # update with new points, compute LL but no fit (since optim=none) > ro$update(y[(no+1):n],rep(0.1^2,n-no), X[(no+1):n,], refit=TRUE) > > test_that(desc="Updated (no refit) Kriging equals Kriging with all data", + expect_equal(ro$T(), r$T(), tol=1e-5)) Test passed 🌈 > > # m1 = microbenchmark::microbenchmark( > # r <- Kriging(y, X, "gauss","constant",FALSE,"none","LL", parameters=list(theta = matrix(.5,ncol=3), sigma2 = 0.1, beta = matrix(0.01))), > # times=100 > # ) > # > # m2 = microbenchmark::microbenchmark( > # { > # ro <- Kriging(y[1:no], X[1:no,], "gauss","constant",FALSE,"none","LL", parameters=list(theta = matrix(.5,ncol=3), sigma2 = 0.1, beta = matrix(0.01))) > # ro$update(y[(no+1):n], X[(no+1):n,], refit=FALSE) > # }, > # times=100 > # ) > > proc.time() user system elapsed 1.98 0.45 2.42