https://github.com/cran/spatstat
Tip revision: 5a6a526cd6a1574a093a7451ca1aead689ee9127 authored by Adrian Baddeley on 23 December 2015, 06:09:40 UTC
version 1.44-0
version 1.44-0
Tip revision: 5a6a526
summary.quad.R
#
# summary.quad.R
#
# summary() method for class "quad"
#
# $Revision: 1.8 $ $Date: 2015/11/27 06:59:30 $
#
summary.quad <- local({
sumriz <- function(ww) {
if(length(ww) > 0)
return(list(range=range(ww), sum=sum(ww)))
else
return(NULL)
}
summary.quad <- function(object, ..., checkdup=FALSE) {
verifyclass(object, "quad")
s <- list(
data = summary.ppp(object$data, checkdup=checkdup),
dummy = summary.ppp(object$dummy, checkdup=checkdup),
param = object$param)
w <- object$w
Z <- is.data(object)
s$w <- list(all = sumriz(w),
data = sumriz(w[Z]),
dummy = sumriz(w[!Z]))
class(s) <- "summary.quad"
return(s)
}
summary.quad
})
print.summary.quad <- local({
summariseweights <- function(ww, blah, dp=3) {
cat(paste(blah, ":\n\t", sep=""))
if(is.null(ww)) {
cat("(None)\n")
return()
}
splat(paste0("range: ",
"[",
paste(signif(ww$range, digits=dp), collapse=", "),
"]\t",
"total: ",
signif(ww$sum, digits=dp)))
}
print.summary.quad <- function(x, ..., dp=3) {
splat("Quadrature scheme = data + dummy + weights")
pa <- x$param
if(is.null(pa))
splat("created by an unknown function.")
splat("\nData pattern:")
print(x$data, dp=dp)
splat("\nDummy quadrature points:")
## How they were computed
if(!is.null(pa)) {
dumpar <- pa$dummy
if(is.null(dumpar))
splat("(provided manually)", indent=5)
else if(is.character(dmethod <- dumpar$method))
splat(dmethod, indent=5)
else if(!is.null(nd <- dumpar$nd)) {
splat(paste0("(",
if(dumpar$random) "stratified random points in " else NULL,
nd[1], " x ", nd[2], " ",
if(!dumpar$quasi) "grid" else
paste(" =", prod(nd), "quasirandom points"),
", plus 4 corner points)"),
indent=5)
} else
splat("(rule for creating dummy points not understood)", indent=5)
}
## Description of them
print(x$dummy, dp=dp)
splat("Quadrature weights:")
## How they were computed
if(!is.null(pa)) {
wpar <- pa$weight
if(is.null(wpar))
splat("(values provided manually)", indent=5)
else if(is.character(wmethod <- wpar$method)) {
switch(wmethod,
grid = {
splat("(counting weights based on",
wpar$ntile[1], "x", wpar$ntile[2],
"array of rectangular tiles)",
indent=5)
},
dirichlet = {
splat("(Dirichlet tile areas, computed",
if(wpar$exact) "exactly)" else "by pixel approximation)",
indent=5)
},
splat(wmethod, indent=5)
)
} else splat("(rule for creating dummy points not understood)")
}
summariseweights(x$w$all, "All weights", dp)
summariseweights(x$w$data, "Weights on data points", dp)
summariseweights(x$w$dummy, "Weights on dummy points", dp)
return(invisible(NULL))
}
print.summary.quad
})
print.quad <- function(x, ...) {
splat("Quadrature scheme")
splat(x$data$n, "data points, ", x$dummy$n, "dummy points")
splat("Total weight ", sum(x$w))
return(invisible(NULL))
}