#
#
#    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)
}