require("ARCHISSUR") require("testthat") seed = 123 # ------------------------------------------------------------- # ------------------------------------------------------------- # ----------------------- Test functions ---------------------- # ------------------------------------------------------------- # ------------------------------------------------------------- ## 20-points DoE, and the corresponding response d <- 2 nb_PX <- 20 Xf <- matrix(c(0.205293785978832, 0.0159983370750337, 0.684774733109666, 0.125251417595962, 0.787208786290006, 0.700475706055049, 0.480507717105934, 0.359730889653793, 0.543665267336735, 0.565974761807069, 0.303412043992361, 0.471502352650857, 0.839505250127309, 0.504914690245002, 0.573294917143728, 0.784444726564573, 0.291681289223421, 0.255053812451938, 0.87233450888786, 0.947168337730927, 0.648262257638515, 0.973264712407035, 0.421877310273815, 0.0686662506387988, 0.190976166753807, 0.810964668176754, 0.918527262507395, 0.161973686467513, 0.0188128700859558, 0.43522031347403, 0.99902788789426, 0.655561821513544, 0.741113863862512, 0.321050086076934, 0.112003007565305, 0.616551317575545, 0.383511473487687, 0.886611679106771, 0.0749211435982952, 0.205805968972305), byrow = T, ncol = d) require(DiceKriging) fx <- apply(Xf, 1, branin) f <- ifelse(fx < 14, -1, 1) require(future) plan(multisession) require(GPCsign) model <- gpcm(f, Xf, seed = seed, coef.m=0.8, coef.cov = c(0.23, 0.68)) #fix gpc theta n.grid <- 10 x.grid <- seq(0,1,length=n.grid) newdata <- expand.grid(x.grid,x.grid) newdata <- as.matrix(newdata) precalc.data <- precomputeUpdateData(model, newdata) newdata.oldsd <- precalc.data$intpoints.oldsd ## new points added new.x <- matrix(c(0.1,0.2),ncol=2,byrow=TRUE) ## prediction at new points pred2 <- predict(object=model,newdata=new.x) Sigma.r <- pred2$cov newdata <- scale(x = newdata, center = model@X.mean, scale = model@X.std) new.x <- scale(x = new.x, center = model@X.mean, scale = model@X.std) kn <- computeQuickgpccov(object = model, integration.points = newdata, X.new = new.x, precalc.data = precalc.data, c.newdata = pred2$c) # test computeQuickgpccov test_that(desc="Test Quickgpccov", expect_true((max(abs(as.vector(kn) - c(-0.05690218,0.1136137,-0.02083037,-0.01017873,0.0004069202,0.0001677692,7.226338e-06,-1.048061e-06,-8.324435e-08,4.349416e-09, -0.08971761,0.1955275,0.01841331,-0.007415768,0.0005248227,0.000168705,5.422774e-06,-1.215662e-06,-7.564289e-08,9.255816e-09,-0.09520585,0.2216334,0.04988536, -0.003928959,0.0002205718,8.384916e-05,6.905699e-07,-3.401236e-07,1.673524e-08,1.418244e-08,-0.04190043,0.1615282,0.0428478,-0.002177196,-4.888025e-05,9.079279e-06, -1.735132e-06,7.061383e-07,6.290054e-08,1.097144e-08,0.01265152,0.08595202,0.02321126,-0.0009481098,-6.841277e-05,-7.333387e-06,-3.326786e-07,8.339018e-07,-4.112297e-08, -6.414055e-10,0.02239705,0.02227259,0.007069909,-0.0004328415,-3.968793e-05,2.605787e-06,2.02905e-06,5.261116e-07,-1.365703e-07,-4.608277e-09,0.01272009,-0.009960771, 0.0003630479,-0.0001352321,-3.641045e-05,4.291002e-06,2.042833e-06,1.614087e-07,-1.415446e-07,9.772267e-10,0.005492955,-0.01269459,0.001171505,0.0002602859,-4.381093e-05, -1.628189e-06,8.591848e-07,-2.779966e-08,-8.796474e-08,5.807188e-09,0.002166942,-0.007521641,0.002212235,0.0003721909,-5.909863e-05,-6.556537e-06,2.561255e-07,-8.263931e-09, -1.75728e-08,9.431911e-09,0.0008139473,-0.0035625,0.001738335,0.0002571164,-5.191697e-05,-6.341884e-06,2.49651e-07,5.38772e-08,2.155685e-08,9.693985e-09 ))) < 1e-6))) updated.predictions <- predict_update_gpc_parallel(Sigma.r = Sigma.r, newdata.oldsd = newdata.oldsd, kn = kn) # Test predict_update_gpc_parallel std <- updated.predictions$sd test_that(desc="Test predict_update_gpc_parallel", expect_true((max(abs(std - c(0.9577251,0.8042763,0.3081484,0.8861983,0.5388343,0.9784575,0.6801836,0.9529644, 0.8257905,0.9602261,0.8773112,0.4842793,0.5342769,0.7714157,0.4275356,0.9581097,0.32005, 0.8774769,0.5610047,0.9118102,0.7700968,0.1910257,0.7370119,0.6304399,0.6121627,0.919228, 0.5862434,0.7204302,0.5622292,0.9105588,0.5922716,0.6273791,0.8474265,0.6335866,0.5488966, 0.8191993,0.8038103,0.5338801,0.7434912,0.931926,0.3263144,0.6817098,0.8748579,0.5128757, 0.6891351,0.6165361,0.9076419,0.6137554,0.7070574,0.8532051,0.6648095,0.34211,0.8560433, 0.6174782,0.8595051,0.2224195,0.9419526,0.5958228,0.7136923,0.5487585,0.8884795,0.2911387, 0.7654442,0.8115228,0.9086982,0.3684321,0.9155361,0.2581236,0.8117233,0.07213529,0.9694573, 0.7034279,0.5364158,0.7914959,0.8547368,0.2952705,0.8115054,0.4475504,0.755442,0.6346291,0.9928677, 0.8801101,0.6330442,0.71195,0.7929009,0.6111933,0.5509113,0.7769666,0.4405667,0.8841773,0.9985298, 0.9620304,0.8687918,0.8324626,0.8772077,0.8502005,0.3510537,0.8993038,0.4203382,0.9631221 ))) < 1e-4))) # # # # # computeVorobTerms function i <- 1 intpoints.oldmean <- precalc.data$intpoints.oldmean sk.new <- updated.predictions$sd pn <- precalc.data$pn.intpoints require(KrigInv) alpha <- KrigInv::vorob_threshold(pn) result <- computeVorobTerms(i = i, object = model, intpoints.oldmean = intpoints.oldmean, krig2 = updated.predictions, sk.new = sk.new, alpha = alpha, gpc = pred2, X.new = new.x) plan(sequential) # test computeVorobTerms pnew <- result$pnew test_that(desc="Test computeVorobTerms", expect_true((max(abs(pnew- c(0.7524454,0.8219528,0.8932705,0.8113889,0.8225016,0.7232321,0.8049784,0.7390806, 0.4821558,0.6168929,0.772691,0.8688688,0.8737031,0.8329445,0.7778296,0.6957348,0.8693093,0.7600779,0.3219381, 0.5620298,0.8014033,0.8904846,0.8406798,0.8430177,0.5820089,0.6433173,0.843105,0.8016384,0.365449,0.5801683, 0.8418064,0.7588137,0.7896971,0.8296309,0.375677,0.6219429,0.8143902,0.844449,0.5705853,0.6685234,0.8636002, 0.5595388,0.7102909,0.8261685,0.4516833,0.7353344,0.7986542,0.8504879,0.7350234,0.7650797,0.7584131,0.2327843, 0.5848729,0.7997765,0.624365,0.8975567,0.7974443,0.8584869,0.8157529,0.861692,0.6898447,0.07833344,0.4370463, 0.7744385,0.7224912,0.8912121,0.8038247,0.8872853,0.8339588,0.923318,0.6819074,0.2521241,0.3326079,0.7813791, 0.7764463,0.876915,0.8221954,0.8666892,0.851675,0.8615613,0.6959557,0.4353873,0.4239621,0.799888,0.80265815, 0.830341,0.8549208,0.8296934,0.8932118,0.8082874,0.7106856,0.5819087,0.5651723,0.7821229,0.7877359,0.7964928, 0.8631803,0.8037025,0.8879889,0.7757952 ))) < 1e-1))) # # # #