https://github.com/cran/fields
Raw File
Tip revision: 56c6d241a6642cc8bd7ee1b4b209bf9888daa74c authored by Doug Nychka on 20 October 2008, 00:00:00 UTC
version 5.01
Tip revision: 56c6d24
derivative.test.R
# fields, Tools for spatial data
# Copyright 2004-2007, Institute for Mathematics Applied Geosciences
# University Corporation for Atmospheric Research
# Licensed under the GPL -- www.gpl.org/licenses/gpl.html

#library( fields, lib.loc="lib.test")

library( fields)
options(echo=FALSE)
test.for.zero.flag<- 1

DD<- cbind( seq(.01,2,,50))
look2<- Wendland(DD, theta=1.5, dimension=2,k=3,derivative=1) 

look1<- (Wendland(DD+1e-5, theta=1.5, dimension=2,k=3)
- Wendland(DD-1e-5, theta=1.5, dimension=2,k=3))/2e-5

test.for.zero( look1, look2,tol=1e-6)

x<- seq( -1,1,,15)

ctest<- rep(0,15)
ctest[8]<- 1

wendland.cov( x,x, k=2, theta=.75)-> look0
look0%*% ctest->look0

wendland.cov( x,x, k=2, theta=.75, C=ctest, derivative=0)-> look

wendland.cov( x,x, k=2, theta=.75, C=ctest, derivative=1)-> look

wendland.cov( x+1e-5, x, k=2, theta=.75, C=ctest)-
wendland.cov( x-1e-5, x, k=2, theta=.75, C=ctest)-> look2
look2<- look2/2e-5
 
test.for.zero( look, look2,tol=1e-7)


x<- make.surface.grid( list(x=seq( -1,1,,40), y=seq( -1,1,,40)))

y<- (.123*x[,1] + .234*x[,2])

obj<- mKrig( x,y, lambda=0, cov.function="wendland.cov", k=3, theta=.2)

xp<- make.surface.grid( list(x=seq(-.5,.5,,24),y= seq( -.5,.5,,24)) )
predict( obj, xp, derivative=1)-> outd
test.for.zero( outd[,1],.123)
test.for.zero( outd[,2],.234)

y<- (x[,1]**2 - 2* x[,1]*x[,2] +  x[,2]**2)/2
obj<- mKrig( x,y, lambda=0, cov.function="wendland.cov", k=3, theta=.2)

predict( obj, xp, derivative=1)-> outd


true<- cbind( xp[,1] -  xp[,2], xp[,2]- xp[,1])

rmse<-sqrt(mean((true[,1] - outd[,1])**2)/mean(true[,1]**2))
test.for.zero( rmse,0, tol=1e-2,relative=FALSE)


rmse<-sqrt(mean((true[,2] - outd[,2])**2)/mean(true[,2]**2))
test.for.zero( rmse,0, tol=1e-2,relative=FALSE)

cat("done with dervative tests", fill=TRUE)
options( echo=TRUE)

back to top