#
#
# hardcore.S
#
# $Revision: 1.4 $ $Date: 2010/07/18 08:46:28 $
#
# The Hard core process
#
# Hardcore() create an instance of the Hard Core process
# [an object of class 'interact']
#
#
# -------------------------------------------------------------------
#
Hardcore <- function(hc) {
out <-
list(
name = "Hard core process",
creator = "Hardcore",
family = pairwise.family,
pot = function(d, par) {
v <- 0 * d
v[ d <= par$hc ] <- (-Inf)
attr(v, "IsOffset") <- TRUE
v
},
par = list(hc = hc),
parnames = "hard core distance",
init = function(self) {
hc <- self$par$hc
if(!is.numeric(hc) || length(hc) != 1 || hc <= 0)
stop("hard core distance hc must be a positive number")
},
update = NULL, # default OK
print = NULL, # default OK
interpret = function(coeffs, self) {
return(NULL)
},
valid = function(coeffs, self) {
return(TRUE)
},
project = function(coeffs, self) {
return(coeffs)
},
irange = function(self, coeffs=NA, epsilon=0, ...) {
hc <- self$par$hc
return(hc)
},
version=versionstring.spatstat(),
# fast evaluation is available for the border correction only
can.do.fast=function(X,correction,par) {
return(all(correction %in% c("border", "none")))
},
fasteval=function(X,U,EqualPairs,pairpot,potpars,correction, ...) {
# fast evaluator for Hardcore interaction
if(!all(correction %in% c("border", "none")))
return(NULL)
if(spatstat.options("fasteval") == "test")
message("Using fast eval for Hardcore")
hc <- potpars$hc
# call evaluator for Strauss process
counts <- strausscounts(U, X, hc, EqualPairs)
# all counts should be zero
v <- matrix(ifelse(counts > 0, -Inf, 0), ncol=1)
attr(v, "IsOffset") <- TRUE
return(v)
}
)
class(out) <- "interact"
(out$init)(out)
return(out)
}