R/f.preCKrige.check.and.test.R

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

# # # Function to check and test whether the input variable fulfil
# # # the minimum requirements
# # # Christoph Hofer, 1-04-2010
f.preCKrige.check.and.test <- function(newdata, neighbours, model, pwidth, pheight, napp )
{

    t.newdata.class <- class( newdata )

    ### in order to use the Function CovairanceFct of the package RandomFields
    RFoldstyle()


    if( t.newdata.class =="SpatialPolygons" || t.newdata.class == "SpatialPolygonsDataFrame" )
    {
	#in no neighbours are defined
	if( missing(neighbours) )
	{
	    neighbours <- lapply( as.list( 1:length(newdata@polygons) ), function( x ){ return( integer(0) ) } )

	}
	stopifnot( is.list(neighbours) )
	#check newdata and neighbour list have the same number of elements
    	stopifnot( length( neighbours ) == length( newdata@polygons ) )

	#check whether all elements in neighbours are numeric
	lapply(neighbours, function(x){ stopifnot( is.numeric( x ) ) } )
	#check whether all numbers in the neighbours list are smaller or equal
	#to the number of elements in the newdata list
	stopifnot( max( c(0, unlist( neighbours )) ) <= length( newdata@polygons ) )

	#check whether the pixel width is a positive real number
	stopifnot( is.numeric( pwidth ) && is.numeric( pheight ) )
	stopifnot( length( pwidth )  == 1 && length( pheight ) == 1 )
	stopifnot( pwidth > 0 && pheight > 0  )
	stopifnot( is.numeric( napp ) && length( napp) == 1 && napp %% 1 == 0)
    }

    if( t.newdata.class =="SpatialPoints" || t.newdata.class == "SpatialPointsDataFrame" )
    {
	#in no neighbours are defined
	if( missing(neighbours) )
	{
	    neighbours <- lapply( as.list( 1:nrow(newdata@coords) ), function( x ){ return( integer(0) ) } )
	}
	stopifnot( is.list(neighbours) )
	if( missing( pwidth) ){pwidth <- 0}
	if( missing( pheight) ){pheight <- 0}
	if( missing( napp ) ){napp  <- 1}

	#check newdata and neighbour list have the same number of elements
    	stopifnot( length( neighbours ) == dim( newdata@coords )[1] )

	#check whether all elements in neighbours are numeric
	lapply( neighbours, function(x){stopifnot( is.numeric( x ) )} )
	#check whether all numbers in the neighbours list are smaller or equal
	#to the number of elements in the newdata
	stopifnot( max( c(0, unlist( neighbours )) ) <= dim( newdata@coords )[1] )
    }

    #check whether there is a covariance model
    t.models <- c("bessel", "cauchy", "cauchytbm", "circular", "constant", "cubic", "dampedcosine",
	"exponential", "gauss", "spherical", "gencauchy","gengneiting","gneiting", "hyperbolic","lgd1",
	"nugget","penta", "power", "wave", "qexponential", "matern", "whittle","stable", "gencauchy", "mev")

    stopifnot( length( model ) > 0 )
    #check whether model$model are cov names of functions implemented in constrainedKriging
    t.mod <- sum(unlist( lapply(model, function(x){ return(sum( x$model == t.models))}) ))
    if( !length( model ) == t.mod ){covmodel(); stop("unknown covariance model name")}

}# end functions