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
|
##
## spatialcdf.R
##
## $Revision: 1.11 $ $Date: 2026/01/21 06:26:39 $
##
spatialcdf <- function(Z, weights=NULL, normalise=FALSE, ...,
W=NULL, Zname=NULL) {
Zdefaultname <- singlestring(short.deparse(substitute(Z)))
if(is.character(Z) && length(Z) == 1) {
if(is.null(Zname)) Zname <- Z
switch(Zname,
x={
Z <- function(x,y) { x }
},
y={
Z <- function(x,y) { y }
},
stop("Unrecognised covariate name")
)
}
if(is.null(Zname)) Zname <- Zdefaultname
##
if(inherits(weights, c("ppm", "kppm", "dppm"))) {
model <- weights
if(!requireNamespace("spatstat.model"))
stop("The package spatstat.model is required", call.=FALSE)
df <- spatstat.model::spatialCovariateUnderModel(model, Z)
G <- with(df, ewcdf(Z, wt, normalise=normalise))
wtname <- if(normalise) "fraction of points" else "number of points"
} else {
if(is.null(W)) W <- as.owin(weights, fatal=FALSE)
if(is.null(W)) W <- as.owin(Z, fatal=FALSE)
if(is.null(W)) stop("No information specifying the spatial window")
M <- as.mask(W, ...)
loc <- as.ppp(rasterxy.mask(M, drop=TRUE), W=W, check=FALSE)
pixelarea <- with(unclass(M), xstep * ystep)
if(is.null(weights)) {
Zvalues <- evaluateCovariateAtPoints(Z, loc, ...)
G <- ewcdf(Zvalues, normalise=normalise, adjust=pixelarea)
wtname <- if(normalise) "fraction of area" else "area"
} else {
Zvalues <- evaluateCovariateAtPoints(Z, loc, ...)
wtvalues <- evaluateCovariateAtPoints(weights, loc, ...)
G <- ewcdf(Zvalues, wtvalues, normalise=normalise, adjust=pixelarea)
wtname <- if(normalise) "fraction of weight" else "weight"
}
}
class(G) <- unique(c("spatialcdf", class(G)))
attr(G, "call") <- sys.call()
attr(G, "Zname") <- Zname
attr(G, "ylab") <- paste("Cumulative", wtname)
return(G)
}
plot.spatialcdf <- function(x, ..., xlab, ylab, do.points=FALSE) {
if(missing(xlab) || is.null(xlab))
xlab <- attr(x, "Zname")
if(missing(ylab) || is.null(ylab))
ylab <- attr(x, "ylab")
if(inherits(x, "ecdf")) {
plot.ecdf(x, ..., xlab=xlab, ylab=ylab, do.points=do.points)
} else {
plot.stepfun(x, ..., xlab=xlab, ylab=ylab, do.points=do.points)
}
}
|
