R/f.points.preCKrige.R

In constrainedKriging: Constrained, Covariance-Matching Constrained and Universal Point or Block Kriging

###############################################################
#                                                             #
#   Berechnungen der Zielpunkt Kovarianzmatrizen              #
#   ch 22-02-2010                                             #
#                                                             #
###############################################################
f.points.preCKrige <- function(newdata, neighbours, model)
{
#
# no attributes -> only for ordinary kriging
# build an empty DataFrame
if( class( newdata ) == "SpatialPoints" ) 
{
    data = as.data.frame( matrix( ncol = 0, nrow = 0 ) )
}
if( class( newdata ) == "SpatialPointsDataFrame" ) 
{
    data = newdata@data
}
#
class( model ) <- "list"
### covmodel of measurement free error process
model.me.free <- model[unlist(lapply(1:length(model), function(i,m){m[[i]]$model != "mev"},m = model))]
### coors are coordinates of the target points
coords <- newdata@coords
#
#if no neighbours are defined
if( missing( neighbours ) )

{
    neighbours <- lapply( as.list( 1:nrow(coords) ), function( x ){ return( integer(0) ) } )
}
stopifnot( is.list( neighbours ) )
#
t.n <- as.list( 1:length( neighbours ) ) 
#
t.covmat.list <- lapply(t.n , function(x, model, neighbours, coords)
    {
	t.point.config  <- c(x, neighbours[[ x ]])
	t.config.coords <- as.matrix( coords[ t.point.config ,], ncol = 2 )
	t.dist <- as.vector( f.row.dist( t.config.coords, t.config.coords ) )
	t.cov <- f.pp.cov( t.dist, model)
	t.n.point.config <- length( t.point.config)

	return(matrix( t.cov, ncol = t.n.point.config, nrow = t.n.point.config ) )
	
    },
    model = model.me.free,
    neighbours = neighbours,
    coords = coords
)
#
posindex <- lapply(t.n,
    		function(x, neighbours)
		{
		    return( c( x, neighbours[[x]] ) )
		},
		neighbours
	    )

return(
    new( "preCKrigePoints",
	covmat = t.covmat.list, # block block Covariance Matrix
	posindex = posindex,
    	model = model,
	data = data, 
	coords = coords)
)
}