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
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
|
#
# plot.plotppm.R
#
# engine of plot method for ppm
#
# $Revision: 1.22 $ $Date: 2020/12/19 05:25:06 $
#
#
plot.plotppm <- function(x,data=NULL,trend=TRUE,cif=TRUE,se=TRUE,
pause=interactive(),
how=c("persp","image","contour"), ...,
pppargs=list())
{
verifyclass(x,"plotppm")
# determine main plotting actions
superimposed <- !is.null(data)
if(!missing(trend) && (trend & is.null(x[["trend"]])))
stop("No trend to plot.\n")
trend <- trend & !is.null(x[["trend"]])
if(!missing(cif) && (cif & is.null(x[["cif"]])))
stop("No cif to plot.\n")
cif <- cif & !is.null(x[["cif"]])
if(!missing(se) && (se & is.null(x[["se"]])))
stop("No SE to plot.\n")
se <- se & !is.null(x[["se"]])
surftypes <- c("trend", "cif", "se")[c(trend, cif, se)]
# marked point process?
mrkvals <- attr(x,"mrkvals")
marked <- (length(mrkvals) > 1)
if(marked)
data.marks <- marks(data)
if(marked & superimposed) {
data.types <- levels(data.marks)
if(any(sort(data.types) != sort(mrkvals)))
stop(paste("Data marks are different from mark",
"values for argument x.\n"))
}
# plotting style
howmat <- outer(how, c("persp", "image", "contour"), "==")
howmatch <- matrowany(howmat)
if (any(!howmatch))
stop(paste("unrecognised option", how[!howmatch]))
# no pause required for single display
if(missing(pause) || is.null(pause)) {
nplots <- length(surftypes) * length(mrkvals)
pause <- interactive() && (nplots != 1)
}
# start plotting
if(pause)
oldpar <- par(ask = TRUE)
on.exit(if(pause) par(oldpar))
for(ttt in surftypes) {
xs <- x[[ttt]]
for (i in seq_along(mrkvals)) {
xsi <- xs[[i]]
level <- mrkvals[i]
main <- paste(if(ttt == "se") "Estimated" else "Fitted",
ttt,
if(marked) paste("\n mark =", level) else NULL)
dont.complain.about(xsi)
for (style in how) {
switch(style,
persp = {
do.call(persp,
resolve.defaults(list(quote(xsi)),
list(...),
spatstat.options("par.persp"),
list(xlab="x", zlab=ttt, main=main)))
},
image = {
do.call(image,
resolve.defaults(list(quote(xsi)),
list(...),
list(main=main)))
if(superimposed) {
X <- if(marked) data[data.marks == level] else data
dont.complain.about(X)
do.call(plot.ppp, append(list(x=quote(X), add=TRUE),
pppargs))
}
},
contour = {
do.call(contour,
resolve.defaults(list(quote(xsi)),
list(...),
list(main=main)))
if(superimposed) {
X <- if(marked) data[data.marks == level] else data
dont.complain.about(X)
do.call(plot.ppp, append(list(x=quote(X), add=TRUE),
pppargs))
}
},
{
stop(paste("Unrecognised plot style", style))
})
}
}
}
return(invisible())
}
print.plotppm <- function(x, ...) {
verifyclass(x, "plotppm")
trend <- x$trend
cif <- x$cif
mrkvals <- attr(x, "mrkvals")
ntypes <- length(mrkvals)
unmarked <- (ntypes == 1 )
cat(paste("Object of class", sQuote("plotppm"), "\n"))
if(unmarked)
cat("Computed for an unmarked point process\n")
else {
cat("Computed for a marked point process, with mark values:\n")
print(mrkvals)
}
cat("Contains the following components:\n")
if(!is.null(trend)) {
cat("\n$trend:\tFitted trend.\n")
if(unmarked) {
cat("A list containing 1 image\n")
print(trend[[1]], ...)
} else {
cat(paste("A list of", ntypes, "images\n"))
cat("Typical details:\n")
print(trend[[1]], ...)
}
}
if(!is.null(cif)) {
cat("\n$cif:\tFitted conditional intensity.\n")
if(unmarked) {
cat("A list containing 1 image\n")
print(cif[[1]], ...)
} else {
cat(paste("A list of", ntypes, "images\n"))
cat("Typical details:\n")
print(cif[[1]], ...)
}
}
invisible(NULL)
}
|
