1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
|
#
#
# pairwise.S
#
# $Revision: 1.12 $ $Date: 2019/02/20 03:32:22 $
#
# Pairwise() create a user-defined pairwise interaction process
# [an object of class 'interact']
#
# -------------------------------------------------------------------
#
Pairwise <- function(pot, name = "user-defined pairwise interaction process",
par = NULL, parnames=NULL,
printfun) {
fop <- names(formals(pot))
if(!isTRUE(all.equal(fop, c("d", "par")))
&& !isTRUE(all.equal(fop, c("d", "tx", "tu", "par"))))
stop(paste("Formal arguments of pair potential function",
sQuote("pot"),
"must be either (d, par) or (d, tx, tu, par)"))
if(!is.null(parnames)) {
stopifnot(is.character(parnames))
if(is.null(par) || length(par) != length(parnames))
stop("par does not match parnames")
}
if(missing(printfun))
printfun <- function(self) {
cat("Potential function:\n")
print(self$pot)
if(!is.null(parnames <- self$parnames)) {
for(i in 1:length(parnames)) {
cat(paste(parnames[i], ":\t"))
pari <- self$par[[i]]
if(is.numeric(pari) && length(pari) == 1)
cat(pari, "\n")
else
print(pari)
}
}
}
out <-
list(
name = name,
creator = "Pairwise",
family = pairwise.family,
pot = pot,
par = par,
parnames = parnames,
hasInf = NA,
init = NULL,
update = function(self, ...){
do.call(Pairwise,
resolve.defaults(list(...),
list(pot=self$pot, name=self$name,
par=self$par, parnames=self$parnames,
printfun=self$print)))
} ,
print = printfun,
version = versionstring.spatstat()
)
class(out) <- "interact"
return(out)
}
Pairwise <- intermaker(Pairwise,
list(creator="Pairwise",
name="user-defined pairwise interaction process",
par=formals(Pairwise),
parnames=list("the potential",
"the name of the interaction",
"the list of parameters",
"a description of each parameter",
"an optional print function")))
|
