https://github.com/cran/spatstat
Tip revision: 3aca716ce2576a0dab83f08052acd47afed8ee6a authored by Adrian Baddeley on 29 February 2012, 00:00:00 UTC
version 1.25-4
version 1.25-4
Tip revision: 3aca716
Gres.R
#
# Gres.R
#
# Residual G
#
# $Revision: 1.1 $ $Date: 2011/06/19 05:57:18 $
#
#############################################################################
#
Gres <- function(object, ...) {
if(!is.fv(object)) {
# usual case where 'object' is a ppm, ppp or quad
G <- Gcom(object, ...)
} else {
# case where 'object' is the output of 'Gcom'
a <- attr(object, "maker")
if(is.null(a) || a != "Gcom")
stop("fv object was not created by Gcom")
G <- object
if(length(list(...)) > 0)
warning("Extra arguments ignored")
}
# initialise fv object
df <- data.frame(r=G$r, theo=rep(0, length(G$r)))
desc <- c("distance argument r", "value 0 corresponding to perfect fit")
ans <- fv(df, "r", substitute(bold(R)~hat(G)(r), NULL),
"theo", . ~ r,
attr(G, "alim"), c("r","bold(R)~%s[theo](r)"), desc, fname="G")
# add residual estimates
nam <- names(G)
if(all(c("border","bcom") %in% nam))
ans <- bind.fv(ans,
data.frame(bres=with(G, border-bcom)),
"bold(R)~hat(%s)[bord](r)",
"border corrected residual of %s",
"bres")
if(all(c("han","hcom") %in% nam))
ans <- bind.fv(ans,
data.frame(hres=with(G, han-hcom)),
"bold(R)~hat(%s)[han](r)",
"Hanisch corrected residual of %s",
"hres")
if("hvar" %in% nam) {
savedotnames <- fvnames(ans, ".")
hsd <- with(G, sqrt(hvar))
ans <- bind.fv(ans,
data.frame(hvar=with(G, hvar),
hsd = hsd,
hi = 2*hsd,
lo = -2*hsd),
c("bold(C)^2~hat(%s)[han](r)",
"sqrt(bold(C)^2~hat(%s)[han](r))",
"bold(R)~hat(%s)[Hi](r)",
"bold(R)~hat(%s)[Lo](r)"),
c("pseudovariance of Hanisch corrected residual %s",
"pseudo-SD of Hanisch corrected residual %s",
"upper critical band for Hanisch corrected residual %s",
"lower critical band for Hanisch corrected residual %s"),
"hres")
ans <- bind.fv(ans,
data.frame(hstdres=with(ans, hres/hsd)),
"bold(T)~hat(%s)[han](r)",
"standardised Hanisch-corrected residual %s",
"hres")
fvnames(ans, ".") <- c(savedotnames, c("hi", "lo"))
}
return(ans)
}