R Under development (unstable) (2024-10-08 r87214 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.

> 
> # LatticeKrig
> # Copyright 2004-2011, Institute for Mathematics Applied Geosciences
> # University Corporation for Atmospheric Research
> # Licensed under the GPL -- www.gpl.org/licenses/gpl.html
> 
> suppressMessages(library( LatticeKrig))
> #options( echo=FALSE)
> 
> ##########################################
>   test.for.zero.flag<- 1
> 
> # test building MRF
>   mx<- rbind(c(5,6))
>  m<- mx[1,1]* mx[1,2]
> temp<- matrix( 1:m, mx[1,1],mx[1,2])
>  m1<- mx[1,1]
>  m2<- mx[1,2]
>    I.c<- temp 
>    I.B<-  cbind(      rep(NA,m1),           temp[,1:(m2-1)])
>    I.T<-  cbind(       temp[,2:m2],        rep(NA,m1))
>    I.L<-  rbind(     rep(NA , m2), temp[ 1:(m1-1),] )
>    I.R<-  rbind(  temp[2:m1 , ],          rep( NA, m2))
> 
>    Bi<- rep( 1:30, 5)
>    Bj<- cbind( c(I.c), c(I.T), c(I.B), c( I.L), c(I.R))
>    test.for.zero( m, m1*m2, tag="initial test on number of basis functions")
Testing:  initial test on number of basis functions
PASSED test at tolerance  1e-08
>    atest<- matrix( (1:m)*5, m1,m2)
>    values<- cbind( c(atest), rep(-1,m),rep(-1,m),rep(-1,m),rep(-1,m) )
>    good<- !is.na(c(Bj))
>    Bi<- Bi[good]
>    Bj<- Bj[good]
>    values<- c(values)[c(good)]
>    LKinfo0<- LKrigSetup(  cbind( c( 1,5), c( 1,6)), NC=6,
+                          a.wght=5, nlevel=1, alpha=1, NC.buffer=0)
>    LKinfo<- LKrigSetup(  cbind( c( 1,5), c( 1,6)), NC=6,
+                          a.wght= list(matrix( (1:m)*5, m, 1)), 
+                          nlevel=1,
+                          alpha=1, NC.buffer=0, 
+                          normalization=TRUE)
>    obj<- LKrigSAR( LKinfo, Level=1)
> 
>    test.for.zero( cbind( Bi,Bj), obj$ind, tag="MRF index")
Testing:  MRF index
PASSED test at tolerance  1e-08
>    test.for.zero( values, obj$ra, tag="MRF value")
Testing:  MRF value
PASSED test at tolerance  1e-08
> 
> # 
> 
>    LKinfo<- LKrigSetup(  cbind( c( 1,5), c( 1,6)), NC=6,
+                          a.wght=list(matrix((1:m)*5,m,1)),
+                          alpha=1, nlevel=1, NC.buffer=0)
>    obj<- LKrigSAR( LKinfo, Level=1)
>    obj2<-spind2full( obj)
>    test2<- matrix( obj2[8,], 5,6)
>    test0<- matrix( 0, 5,6)
>    test0[3,2]<- 5*8
>    test0[2,2]<- test0[3,1]<- test0[4,2]<- test0[3,3] <- -1
>    test.for.zero( test2, test0, tag="MRF weight placement")
Testing:  MRF weight placement
PASSED test at tolerance  1e-08
> 
> 
> ############ end of simple MRF tests
> 
> 
> # now everything
> # TEST INDEXING
> #
>   set.seed(123)
>   x1<- cbind( runif( 10), runif(10))
>   LKinfo<- LKrigSetup( cbind( c( -1,1), c( -1,1) ),
+              nlevel=3, NC=4, a.wght=list(5,6,7), 
+              alpha=c(6,6,6) )
>   X<- LKrig.basis(x1, LKinfo)
>   X<- as.matrix(X)
> # check on normalization to unit variance at each level
>   Q<- LKrig.precision( LKinfo)
>   Q<- as.matrix( Q)
>   look<- (X)%*% solve( Q) %*%t(X)
>   marginal.var<- sum(unlist(LKinfo$alpha))
>   test.for.zero( diag(look), rep( marginal.var,10),
+                 tag="normalization to unit variance at each level",
+                 tol=5e-7)
Testing:  normalization to unit variance at each level
PASSED test at tolerance  5e-07
>   look2<- LKrig.cov( x1, LKinfo= LKinfo, marginal=TRUE)
>   test.for.zero( look2, rep(marginal.var,10) ,
+                 tag="normalization based on logic in LKrig.cov",
+                 tol=5e-7)
Testing:  normalization based on logic in LKrig.cov
PASSED test at tolerance  5e-07
> # check full covariance matrix
>   look3<- LKrig.cov( x1, x1,LKinfo= LKinfo)
>   test.for.zero( look3, look, tag="full covariance from matrix expressions")
Testing:  full covariance from matrix expressions
PASSED test at tolerance  1e-08
> # Now test w/o normalization
>   LKinfo$normalize<- FALSE
>   X<- LKrig.basis(x1, LKinfo)
>   X<- as.matrix(X)
> # check on normalization to unit variance at each level
>   Q<- LKrig.precision( LKinfo)
>   Q<- as.matrix( Q)
>   look<- (X)%*% solve( Q) %*%t(X)
>   look3<- LKrig.cov( x1, x1,LKinfo= LKinfo)
>   test.for.zero( look3, look,
+              tag="full covariance from matrix expressions w/o normalization")
Testing:  full covariance from matrix expressions w/o normalization
PASSED test at tolerance  1e-08
> #
> # check of component covariance matrices
>    LKinfo<- LKrigSetup( cbind( c( -1,1), c( -1,1) ), nlevel=3, NC=5,
+                         a.wght=list(5,6,7), alpha=c(4,2,1), NC.buffer=0)
>   set.seed(123)
>   x1<- cbind( runif( 10), runif(10))
>   x2<- cbind(0,0)
>   comp<- matrix( NA,10, 3)   
>   aTemp<- c(5,6,7)
>   for ( l in 1:3){
+        LKinfo.temp<- LKrigSetup( cbind( c( -1,1), c( -1,1) ),
+                         nlevel=1, NC = LKinfo$latticeInfo$mx[l],
+                         a.wght=aTemp[l], alpha=1.0, NC.buffer=0)
+        comp[,l]<- LKrig.cov(x1,x2,LKinfo.temp )
+   }
>   look1<- comp%*%c(unlist( LKinfo$alpha))
>   look3<- LKrig.cov( x1, x2, LKinfo= LKinfo)
>   test.for.zero( look1, look3, tag="comp normalized cov and LKrig.cov")
Testing:  comp normalized cov and LKrig.cov
PASSED test at tolerance  1e-08
> #
> 
> 
> # test of buffer grid points.
>  NC.buffer<- 7
>   LKinfo0 <- LKrigSetup( cbind( c( -1,1), c( 0,3) ), nlevel=3, NC=12,
+                         a.wght=list(5,6,7), alpha=c(4,2,1), NC.buffer=0)
>   LKinfo7 <- LKrigSetup( cbind( c( -1,1), c( 0,3) ), nlevel=3, NC=12,
+                         a.wght=list(5,6,7), alpha=c(4,2,1), NC.buffer=NC.buffer)
>   check.sum <- 0
>   for(k in 1:3){
+     check.sum <- check.sum + length((LKinfo0$latticeInfo$grid[[k]])$x) +2*NC.buffer - length((LKinfo7$latticeInfo$grid[[k]])$x)
+     check.sum <- check.sum + length((LKinfo0$latticeInfo$grid[[k]])$y) +2*NC.buffer - length((LKinfo7$latticeInfo$grid[[k]])$y)
+     
+   }
>   test.for.zero( check.sum, 0, relative=FALSE, tag="adding  7 buffer points")
Testing:  adding  7 buffer points
PASSED test at tolerance  1e-08
> # getting the margins and spatial domain right
> # this test works because x y aspects are both divided evenly by delta.
>    
>  check.sum<-0
>  for(k in 1:3){
+     check.sum <- check.sum + (LKinfo0$latticeInfo$grid[[k]])$x[1] - (LKinfo7$latticeInfo$grid[[k]])$x[NC.buffer +1] 
+     check.sum <- check.sum +  (LKinfo0$latticeInfo$grid[[k]])$y[1] - (LKinfo7$latticeInfo$grid[[k]])$y[NC.buffer +1]
+     m2<- LKinfo7$mx[k,1]
+     n2<- LKinfo7$mx[k,2]
+     check.sum <- check.sum + max((LKinfo0$latticeInfo$grid[[k]])$x) - (LKinfo7$latticeInfo$grid[[k]])$x[m2 - NC.buffer] 
+     check.sum <- check.sum + max((LKinfo0$latticeInfo$grid[[k]])$y) - (LKinfo7$latticeInfo$grid[[k]])$y[n2 -NC.buffer] 
+   }
>  test.for.zero( check.sum, 0, relative=FALSE,tol=1e-8, tag="correct nesting of buffer=0  grid")
Testing:  correct nesting of buffer=0  grid
PASSED test at tolerance  1e-08
>  cat("Done testing LKrig.precision",fill=TRUE)
Done testing LKrig.precision
>   options( echo=FALSE)
> proc.time()
   user  system elapsed 
  14.21    0.25   14.45