tests/cov.test.R

In fields: Tools for Spatial Data

#
# fields  is a package for analysis of spatial data written for
# the R software environment.
# Copyright (C) 2022 Colorado School of Mines
# 1500 Illinois St., Golden, CO 80401
# Contact: Douglas Nychka,  douglasnychka@gmail.edu,
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with the R software environment if not, write to the Free Software
# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
# or see http://www.r-project.org/Licenses/GPL-2
##END HEADER
##END HEADER


suppressMessages(library(fields))
options( echo=FALSE)
test.for.zero.flag<- 1
data(ozone2)
y<- ozone2$y[16,]
x<- ozone2$lon.lat
#
# Omit the NAs
good<- !is.na( y)
x<- x[good,]
y<- y[good]
x1<- x[1:5,]
x2<- x[6:11,]

look<- exp(-1*rdist(x1,x2)/4)
look2<- stationary.cov( x1,x2, aRange=4)
look3<- Exp.cov( x1, x2, aRange=4.0)
test.for.zero( look, look2)
test.for.zero( look, look3)

set.seed(122)
C<-  rnorm( nrow(x2))
look<- exp(-1*rdist(x1,x2)/4)%*%C
look2<- stationary.cov( x1,x2, aRange=4, C=C)
look3<- Exp.cov( x1, x2, aRange=4.0, C=C)
test.for.zero( look, look2)
test.for.zero( look, look3)

#### check tranformation of coordinates
V<- matrix( c(2,1,0,4), 2,2)
Vi<- solve( V)
u1<- t(Vi%*% t(x1))
u2<- t(Vi%*% t(x2))

look<- exp(-1*rdist(u1,u2))
look2<- stationary.cov( x1,x2, V= V)
test.for.zero( look, look2)

look<- Wendland(rdist(u1,u2), k=3, dimension=2)
look2<- stationary.cov( x1,x2, V= V, Covariance = "Wendland",
                       k=3, dimension=2)
test.for.zero( look, look2)

### check tapering of covariances
x1<- x[1:5,]
x2<- x[2:6,]
V<- matrix( c(2,1,0,4), 2,2)
Vi<- solve( V)

u1<- x1
u2<- x2

look1a<- exp(-1*rdist(u1,u2))
look1b<-  Wendland(rdist(u1,u2),
                                      k=3, dimension=2, aRange= 1)
look1<- look1a*look1b
look2<- stationary.taper.cov( x1,x2, aRange=1,
               Taper.args=list( aRange=1,k=3, dimension=2), verbose=FALSE)
test.for.zero( look1, as.matrix(look2))


u1<- t(Vi%*% t(x1))
u2<- t(Vi%*% t(x2))


look1a<- exp(-1*rdist(u1,u2))
look1b<-  Wendland(rdist(u1,u2),
                                      k=3, dimension=2, aRange= 1.5)
look1<- look1a*look1b
look2<- stationary.taper.cov( x1,x2,V=V,
               Taper.args=list( aRange=1.5,k=3, dimension=2), verbose=FALSE)
test.for.zero( look1, as.matrix(look2))


u1<- t(Vi%*% t(x1))
u2<- t(Vi%*% t(x2))


look1a<- Matern(rdist(u1,u2), smoothness=1.5)
look1b<-  Wendland(rdist(u1,u2),
                                      k=3, dimension=2, aRange= 1.5)
look1<- look1a*look1b
look2<- stationary.taper.cov( x1,x2,V=V,Covariance=Matern, smoothness=1.5,
               Taper.args=list( aRange=1.5,k=3, dimension=2), verbose=FALSE)
test.for.zero( look1, as.matrix(look2))


# some tests of great circle distance


stationary.taper.cov( x[1:3,],x[1:10,] , aRange=200, Taper.args= 
       list(k=2,aRange=300, dimension=2),
       Dist.args=list( method="greatcircle") )-> temp

# temp is now a tapered 3X10 cross covariance matrix in sparse format. 
# should be identical to
# the direct matrix product

temp2<- Exponential( rdist.earth(x[1:3,],x[1:10,]), aRange=200) * 
           Wendland(rdist.earth(x[1:3,],x[1:10,]),  aRange= 300, k=2, dimension=2)

test.for.zero(  as.matrix(temp), temp2, tol=2e-6, tag="taper with great circle")

# example of calling the taper version directly 
# Note that default covariance is exponential and default taper is 
# Wendland (k=2).

stationary.taper.cov( x[1:3,],x[1:10,] , aRange=1.5, Taper.args= 
      list(k=2,aRange=2.0, dimension=2) )-> temp
# temp is now a tapered 5X10 cross covariance matrix in sparse format. 
# should be identical to
# the direct matrix product

temp2<- Exp.cov( x[1:3,],x[1:10,], aRange=1.5) * 
           Wendland(rdist(x[1:3,],x[1:10,]),
                      aRange= 2.0, k=2, dimension=2)

test.for.zero(  as.matrix(temp), temp2, tag= "high level test of taper cov")

stationary.taper.cov( x[1:3,],x[1:10,] , range=1.5,
        Taper.args= list(k=2,aRange=2.0,
                       dimension=2) )-> temp

test.for.zero(  as.matrix(temp), temp2, tag= "high level test of taper cov")

cat("end tests of V argument in covariances", fill=TRUE)