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
model.depends.R
#
# Determine which 'canonical variables' depend on a supplied covariate
#
# $Revision: 1.4 $ $Date: 2011/11/21 06:40:09 $
#
model.depends <- function(object) {
# supplied covariates
fo <- formula(object)
if(length(as.list(fo)) == 3) {
# formula has a response: strip it
fo <- fo[-2]
}
covars <- variablesinformula(fo)
# canonical covariates
mm <- model.matrix(object)
ass <- attr(mm, "assign")
# model terms
tt <- terms(object)
lab <- attr(tt, "term.labels")
# 'ass' maps canonical covariates to 'lab'
# determine which canonical covariate depends on which supplied covariate
depends <- matrix(FALSE, length(ass), length(covars))
for(i in seq(along=ass)) {
if(ass[i] == 0) # 0 is the intercept term
depends[i,] <- FALSE
else {
turm <- lab[ass[i]]
depends[i, ] <- covars %in% all.vars(parse(text=turm))
}
}
rownames(depends) <- colnames(mm)
colnames(depends) <- covars
# detect offsets
if(!is.null(oo <- attr(tt, "offset")) && ((noo <- length(oo)) > 0)) {
# entries of 'oo' index the list of variables in terms object
vv <- attr(tt, "variables")
offdep <- matrix(FALSE, noo, length(covars))
offnms <- character(noo)
for(i in seq_len(noo)) {
offseti <- languageEl(vv, oo[i] + 1)
offdep[i, ] <- covars %in% all.vars(offseti)
offnms[i] <- deparse(offseti)
}
rownames(offdep) <- offnms
colnames(offdep) <- covars
attr(depends, "offset") <- offdep
}
return(depends)
}
model.is.additive <- function(object) {
dep <- model.depends(object)
hit <- t(dep) %*% dep
diag(hit) <- 0
ok <- all(hit == 0)
return(ok)
}
model.covariates <- function(object, fitted=TRUE, offset=TRUE) {
md <- model.depends(object)
nm <- colnames(md)
keep <- rep(FALSE, length(nm))
# variables used in formula with coefficients
if(fitted) keep <- apply(md, 2, any)
# variables used in offset
if(offset) {
oo <- attr(md, "offset")
if(!is.null(oo))
keep <- keep | apply(oo, 2, any)
}
return(nm[keep])
}