tests/LKrig.test.3D.R

In LatticeKrig: Multi-Resolution Kriging Based on Markov Random Fields

suppressMessages(library( LatticeKrig))
#
options(echo=FALSE)
test.for.zero.flag<- 1
#
# Near interpolation of a 3d function 
set.seed( 123)
N<- 1e3
x<-  matrix( runif(3* N,-1,1), ncol=3, nrow=N)
y<-   10*exp( -rdist( x, rbind( c(.5,.5,.6) ) )/.5)
glist<- list( x1=seq( -1,1,,30), x2=seq( -1,1,,30), x3= 0)
xgrid<- make.surface.grid( glist)
yTrue<-   10*exp( -rdist( xgrid, rbind( c(.5,.5,.6) ) )/.5)

LKinfo<- LKrigSetup( x,  nlevel=1,  a.wght= 6.2, NC=8, NC.buffer=2,
                    LKGeometry="LKBox", normalize=TRUE, mean.neighbor=200,
                    choleskyMemory=list(nnzR= 2e6))

out1<- LatticeKrig( x,y, LKinfo=LKinfo)
yTest<- predict( out1, xgrid)
# accuracy within a few percent relative error.
test.for.zero( mean( abs(yTest- yTrue)/yTrue), 0, relative=FALSE, tol=5e-3 )

# multi level  model

LKinfo<- LKrigSetup( x,  nlevel=3,  a.wght= 8, alpha=c( 1,.5, .2),
                    NC=3, NC.buffer=1,
                    LKGeometry="LKBox", normalize=TRUE, mean.neighbor=200,
                    choleskyMemory=list(nnzR= 2e6))

# test of finding nearest lattice neighbors
#remove( test.for.zero.flag)
   cat(" Exahautive test of 3d box lattice", fill=TRUE)
for(  level in 1:LKinfo$nlevel){
m1<- LKinfo$latticeInfo$mLevel[level]
mx1<- LKinfo$latticeInfo$mx[level,]
indexgrid<- as.matrix( expand.grid( list(1:mx1[1], 1:mx1[2], 1:mx1[3] )))
look<- LKrigSAR( LKinfo, Level=level)
BigD<- rdist( indexgrid, indexgrid)
allNodes<- 1:m1
for(  k in 1:m1){
#	cat( k, " ")
	i1<- look$ind[ look$ind[,1]==k,2]
	i2<- allNodes[ BigD[k,]<=1.0]
#	print( length( i1) - length(i2))
	test.for.zero( sort( i1), sort( i2)) 	
 }
    cat(" ", fill=TRUE)
    cat( " done  with level ", level, fill=TRUE)
}



glist<- list( x1=seq( -1,1,,30), x2=seq( -1,1,,30), x3= 0)
xgrid<- make.surface.grid( glist)

look3<- LKrig.cov( xgrid, LKinfo=LKinfo, marginal=TRUE)
varTest<- sum( unlist(LKinfo$alpha))
test.for.zero( look3, varTest, tag="checking computation of marginal variance LKBox")