tests/testthat/test_kernelCpp.R

In magi: MAnifold-Constrained Gaussian Process Inference

library(testthat)
testthat::context("testing GP kernel cpp functions")

phitrue <- list(
  generalMatern = c(2.04, 1.313)
)

xtime <- seq(0,20,0.5)

kerneltype <- "generalMatern"
testthat::test_that("check C, dCdphi for generalMatern",{
  
  egcovR <- calCov(phitrue[[kerneltype]], 
                   as.matrix(dist(xtime)),
                   -sign(outer(xtime,xtime,'-')),
                   kerneltype = kerneltype)
  dimnames(egcovR$Cdoubleprime) <- NULL
  dimnames(egcovR$C) <- NULL
  
  egcovC <- generalMaternCovRcpp(phitrue[[kerneltype]], outer(xtime,xtime,'-'))
  expect_equal(egcovC$C, egcovR$C, check.attributes = FALSE)
  expect_equal(egcovC$dCdphiCube, egcovR$dCdphiCube, check.attributes = FALSE)
  expect_equal(egcovC$Cprime, egcovR$Cprime, check.attributes = FALSE)
  expect_equal(egcovC$Cdoubleprime, egcovR$Cdoubleprime, check.attributes = FALSE)
  expect_equal(egcovC$Cinv, egcovR$Cinv, check.attributes = FALSE)
  expect_equal(egcovC$mphi, egcovR$mphi, check.attributes = FALSE)
  expect_equal(egcovC$Kinv, egcovR$Kinv, check.attributes = FALSE, tolerance = 1e-5)
 
  dim(egcovC$Sigma)
  dim(egcovC$dSigmadphiCube)
  
  #if(interactive()){
  #  mb <- microbenchmark::microbenchmark(
  #    egcovR <- calCovGeneralMatern(phitrue[[kerneltype]],
  #                                  as.matrix(dist(xtime)),
  #                                  -sign(outer(xtime,xtime,'-'))),
  #    egcovC <- generalMaternCovRcpp(phitrue[[kerneltype]], outer(xtime,xtime,'-'))
  #  )
  #  print(mb)
  #}
  
})


testthat::test_that("generalMatern analytical / numerical gradient",{
  xtime <- seq(0,2,0.1)
  testpintPhi <- rexp(2)
  delta <- 1e-4
  egcov0 <- calCov(testpintPhi, 
                   as.matrix(dist(xtime)),
                   -sign(outer(xtime,xtime,'-')),
                   kerneltype = "generalMatern")
  
  egcov0cpp <- generalMaternCovRcpp(testpintPhi, outer(xtime,xtime,'-'))
  dimnames(egcov0$C) <- NULL
  dimnames(egcov0$dCdphiCube) <- NULL
  expect_equal(egcov0cpp$C, egcov0$C, check.attributes = FALSE, tolerance=1e-6)
  expect_equal(egcov0cpp$dCdphiCube, egcov0$dCdphiCube, check.attributes = FALSE, tolerance=1e-6)
  expect_equal(egcov0cpp$Cprime, egcov0$Cprime, check.attributes = FALSE)
  expect_equal(egcov0cpp$Cdoubleprime, egcov0$Cdoubleprime, check.attributes = FALSE)
  
  egcov0cpp$dCprimedphiCube
  egcov0cpp$dCdoubleprimedphiCube
  
  
  for(it in 1:length(testpintPhi)){
    testpintPhi1 <- testpintPhi
    testpintPhi1[it] <- testpintPhi1[it] + delta
    egcov1cpp <- generalMaternCovRcpp(testpintPhi1, outer(xtime,xtime,'-'))
    expect_equal((egcov1cpp$C - egcov0cpp$C)/delta, egcov0cpp$dCdphiCube[,,it],
                 tolerance = 1e-3, scale = max(abs(egcov0cpp$dCdphiCube[,,it])))
    
    expect_equal((egcov1cpp$Cprime - egcov0cpp$Cprime)/delta, egcov0cpp$dCprimedphiCube[,,it],
                 tolerance = 1e-3, scale = max(abs(egcov0cpp$dCprimedphiCube[,,it])))
    
    expect_equal((egcov1cpp$Cdoubleprime - egcov0cpp$Cdoubleprime)/delta, egcov0cpp$dCdoubleprimedphiCube[,,it],
                 tolerance = 1e-3, scale = max(abs(egcov0cpp$dCdoubleprimedphiCube[,,it])))
    
  }
})

testthat::test_that("check Cprime and Cdoubleprime", {
  xtime <- seq(0,10e-3,1e-3)
  delta <- mean(diff(xtime))
  testpintPhi <- rexp(2)
  egcov2cpp <- generalMaternCovRcpp(testpintPhi, outer(xtime,xtime,'-'))
  egcov2 <- calCov(testpintPhi, 
                   as.matrix(dist(xtime)),
                   -sign(outer(xtime,xtime,'-')),
                   kerneltype = kerneltype,
                   noiseInjection = 0)
  dimnames(egcov2$Cprime) <- NULL
  dimnames(egcov2$Cdoubleprime) <- NULL
  dimnames(egcov2$C) <- NULL
  testthat::expect_equal( egcov2cpp$Cprime, egcov2$Cprime)
  testthat::expect_equal( egcov2cpp$Cdoubleprime, egcov2$Cdoubleprime)
  
  testthat::expect_equal( ((egcov2$Cprime[-1,1] + egcov2$Cprime[-nrow(egcov2$Cprime),1])/2), 
                          (diff(egcov2$C[,1])/delta), 
                          tolerance = 0.0001, scale=max(abs(egcov2$Cprime[-1,1])))
  testthat::expect_equal( (egcov2$Cdoubleprime[-1,1] + egcov2$Cdoubleprime[-nrow(egcov2$Cdoubleprime),1])/2, 
                          -diff(egcov2$Cprime[,1])/delta, 
                          tolerance = 0.001, scale=max(abs(egcov2$Cdoubleprime[-1,1])))
})