Raw File
fii.R
#
# 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)
}


back to top