Description Usage Arguments Value Author(s) See Also Examples
View source: R/RunCrossValidation.R
Cross validation function for kriging; a wrapper around the krige.cv
function in the gstat package.
This function may be used to identify negative aspects of a kriging model, such as the worst errors or the areas with consistent bias.
1 2 | RunCrossValidation(formula, pts, model, nfold = nrow(pts), ...,
projargs = proj4string(pts))
|
formula |
|
pts |
|
model |
|
nfold |
|
... |
other arguments that will be passed to |
projargs |
|
Returns a list
with components:
cv |
|
me |
|
mspe |
|
cor.op |
|
cor.pr |
|
J.C. Fisher
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 | data(ESRP_NWIS)
data(ESRP_Boundary)
data(ESRP_NED)
# Set datum and projection
crs <- CRS(proj4string(ESRP_NED))
pts <- spTransform(ESRP_NWIS, crs)
ply <- spTransform(ESRP_Boundary, crs)
# Exclude grid points outside polygon
grd <- ESRP_NED
grd$var2 <- grd$var2 * over(as(grd, "SpatialPoints"),
as(ply, "SpatialPolygons"))
# Set axis limits
xlim <- c(10000, 328000)
ylim <- c(81200, 335700)
# Kriging function with plotting routine
Krige <- function(fo, model, xlim, ylim, ...) {
kr <- krige(formula = fo, locations = pts, newdata = grd, model = model, ...)
kr$var1.se <- sqrt(kr$var1.var)
pal1 <- colorRampPalette(c("#F02311", "#F7FDFA", "#107FC9"))
pal2 <- terrain.colors
PlotRaster(kr, "var1.pred", pts, xlim = xlim, ylim = ylim, pal = pal1,
main = "Predictions", contour = TRUE)
PlotRaster(kr, "var1.se", pts, xlim = xlim, ylim = ylim, pal = pal2,
main = "Standard errors")
}
### Universal Kriging (UK), accounts for linear spatial trend:
fo <- var1 ~ x + y
lm.trend <- lm(fo, data = pts)
summary(lm.trend)
vg <- variogram(fo, pts, cutoff = 150000)
model <- fit.variogram(vg, vgm(psill = 1500, model = "Sph", range = 100000,
nugget = 0), fit.method = 1)
plot(vg, model, main = "Residual variogram model (var1 ~ x + y)")
Krige(fo, model, xlim, ylim)
cv <- RunCrossValidation(fo, pts, model = model)
cat(cv$me, cv$mspe, cv$cor.op, cv$cor.pr, "\n")
### Kriging with External Drift (KED); assumes var1 forms a subdued replica of var2:
fo <- var1 ~ var2
lm.trend <- lm(fo, data = pts)
summary(lm.trend)
plot(fo, pts, main = "Correlation plot and fitted regression model")
abline(lm.trend)
vg <- variogram(fo, pts)
model <- fit.variogram(vg, vgm(psill = 4500, model = "Sph", range = 100000,
nugget = 0), fit.method = 1)
plot(vg, model, main = "Residual variogram model (var1 ~ var2)")
Krige(fo, model, xlim, ylim)
cv <- RunCrossValidation(fo, pts, model = model)
cat(cv$me, cv$mspe, cv$cor.op, cv$cor.pr, "\n")
PlotBubble(cv$cv, "residual", ply , xlim , ylim, main = "Residuals")
# KED in a local neighborhood:
cv <- RunCrossValidation(fo, pts, model = model, nmax = 50)
cat(cv$me, cv$mspe, cv$cor.op, cv$cor.pr, "\n")
|
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.