#
# fii.R
#
# Class of fitted interpoint interactions
#
#
fii <- function(interaction=NULL, coefs=numeric(0), Vnames=character(0)) {
if(is.null(interaction))
interaction <- Poisson()
stopifnot(is.interact(interaction))
if(is.poisson.interact(interaction)) {
if(length(Vnames) > 0)
stop("Coefficients inappropriate for Poisson process")
}
out <- list(interaction=interaction,
coefs=coefs,
Vnames=Vnames)
class(out) <- c("fii", class(out))
return(out)
}
summary.fii <- function(object, ...) {
y <- unclass(object)
INTERACT <- object$interaction
coefs <- object$coefs
Vnames <- object$Vnames
y$poisson <- is.poisson.interact(INTERACT)
if(!y$poisson) {
if(!is.null(INTERACT$interpret)) {
# invoke auto-interpretation feature
sensible <-
if(newstyle.coeff.handling(INTERACT))
(INTERACT$interpret)(coefs[Vnames], INTERACT)
else
(INTERACT$interpret)(coefs, INTERACT)
header <- paste("Fitted", sensible$inames)
printable <- sensible$printable
} else {
# fallback
sensible <- NULL
header <- "Fitted interaction terms"
printable <- exp(unlist(coefs[Vnames]))
}
y <- append(y, list(sensible=sensible,
header=header,
printable=printable))
}
class(y) <- c("summary.fii", class(y))
return(y)
}
print.fii <- function(x, ...) {
print(summary(x), brief=TRUE)
return(invisible(NULL))
}
print.summary.fii <- function(x, ...) {
secret <- resolve.defaults(list(...),
list(prefix="Interaction: ",
family=TRUE,
brief=FALSE))
brief <- secret$brief
if(!brief)
cat(secret$prefix)
if(x$poisson)
cat("Poisson process\n")
else {
print(x$interaction, family=secret$family, brief=TRUE)
if(length(x$printable) == 1)
cat(paste(x$header, ":\t", x$printable, "\n", sep=""))
else {
cat(paste(x$header, ":\n", sep=""))
print(x$printable)
}
}
if(!brief) {
cat("\nRelevant coefficients:\n")
print(x$coefs[x$Vnames])
}
return(invisible(NULL))
}
reach.fii <- function(x, ..., epsilon=0) {
inte <- x$interaction
coeffs <- x$coefs
Vnames <- x$Vnames
if(is.poisson.interact(inte))
return(0)
# get 'irange' function from interaction object
irange <- inte$irange
if(is.null(irange))
return(Inf)
# apply 'irange' function using fitted coefficients
if(newstyle.coeff.handling(inte))
ir <- irange(inte, coeffs[Vnames], epsilon=epsilon)
else
ir <- irange(inte, coeffs, epsilon=epsilon)
if(is.na(ir))
ir <- Inf
return(ir)
}
plot.fii <- function(x, ...) {
if(is.poisson.interact(x$interaction)) {
message("Poisson interaction; nothing plotted")
return(invisible(NULL))
}
plfun <- x$interaction$family$plot
if(is.null(plfun))
stop("Plotting not implemented for this type of interaction")
plfun(x, ...)
}
fitin <- function(object) {
UseMethod("fitin")
}
fitin.ppm <- function(object) {
f <- object$fitin
if(!is.null(f))
return(f)
# For compatibility with older versions
inte <- object$interaction
if(is.null(inte))
f <- fii() # Poisson
else {
coefs <- coef(object)
Vnames <- object$internal$Vnames
# Internal names of regressor variables
f <- fii(inte, coefs, Vnames)
}
return(f)
}