https://github.com/cran/spatstat
Revision 0653ba23e445bd2053eab7d684f64b4335854650 authored by Adrian Baddeley on 18 March 2008, 23:05:24 UTC, committed by cran-robot on 18 March 2008, 23:05:24 UTC
1 parent 2151b17
Tip revision: 0653ba23e445bd2053eab7d684f64b4335854650 authored by Adrian Baddeley on 18 March 2008, 23:05:24 UTC
version 1.12-9
version 1.12-9
Tip revision: 0653ba2
dg.S
#
# dg.S
#
# $Revision: 1.8 $ $Date: 2007/01/11 03:36:02 $
#
# Diggle-Gratton pair potential
#
#
DiggleGratton <- function(delta, rho) {
out <-
list(
name = "Diggle-Gratton process",
creator = "DiggleGratton",
family = pairwise.family,
pot = function(d, par) {
delta <- par$delta
rho <- par$rho
above <- (d > rho)
inrange <- (!above) & (d > delta)
h <- above + inrange * (d - delta)/(rho - delta)
return(log(h))
},
par = list(delta=delta, rho=rho),
parnames = list("lower limit delta", "upper limit rho"),
init = function(self) {
r <- self$par$delta
r <- self$par$rho
if(!is.numeric(delta) || length(delta) != 1)
stop("lower limit delta must be a single number")
if(!is.numeric(rho) || length(rho) != 1)
stop("upper limit rho must be a single number")
stopifnot(delta >= 0)
stopifnot(rho > delta)
stopifnot(is.finite(rho))
},
update = NULL, # default OK
print = NULL, # default OK
interpret = function(coeffs, self) {
kappa <- as.numeric(coeffs[1])
return(list(param=list(kappa=kappa),
inames="exponent kappa",
printable=round(kappa,4)))
},
valid = function(coeffs, self) {
kappa <- ((self$interpret)(coeffs, self))$param$kappa
return(is.finite(kappa) && (kappa >= 0))
},
project = function(coeffs, self) {
kappa <- as.numeric(coeffs[1])
coeffs[1] <- if(is.na(kappa)) 0 else max(0, kappa)
return(coeffs)
},
irange = function(self, coeffs=NA, epsilon=0, ...) {
rho <- self$par$rho
if(all(is.na(coeffs)))
return(rho)
kappa <- coeffs[1]
delta <- self$par$delta
if(abs(kappa) <= epsilon)
return(delta)
else return(rho)
},
version=versionstring.spatstat()
)
class(out) <- "interact"
out$init(out)
return(out)
}
Computing file changes ...