#
# 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])
}