R/print.R

In multiRec: Analysis of Multi-Type Recurrent Events

#' Print a short summary of the model fit
#'
#' @param x an object of type multiRec
#' @param digits integer, the number of decimal digits to display for parameters.
#' @param ... not used
#' @return Invisibly returns the input object \code{x}. Called for side effects (printing).
#' @importFrom stats AIC BIC
#' @export
print.multiRec = function(x, digits=4, ...) {
  linkName = x$link$link
  beta = x$coefficients
  beta[,4:7] = round(beta[,4:7],digits)

  # Format p-values
  beta[,7] = ifelse(beta[,7]<0.0001,'<0.0001',sprintf(' %.4f',beta[,7]))

  # Fix alignment
  nc = max(nchar(beta$component))
  np = max(nchar(beta$parameter))
  beta$component = sprintf('%-*s',nc,beta$component)
  names(beta)[2] = sprintf('%-*s',nc,names(beta)[2])

  beta$parameter = sprintf('%-*s',np,beta$parameter)
  names(beta)[3] = sprintf('%-*s',np,names(beta)[3])

  cat('Link: ',linkName,'\n',sep='')
  cat('\n')

  if (linkName=='log') {
    ix = which(colnames(beta)=='estimate')
    beta = cbind(beta[1:ix],
                 'exp(estimate)'=round(exp(beta[,ix]),digits),
                 beta[,(ix+1):ncol(beta)])
  }
  names(beta)[names(beta)=='se'] = 'se(estimate)'

  for (h in unique(beta[,1])) {
    if (!h %in% names(x$calls)) next
    cat('Call: ',x$calls[h],'\n')
    print(beta[beta[,1]==h,-1],row.names=FALSE)
    cat('\n')
  }

  cat(sprintf('AIC=%.3f, BIC=%.3f\n',AIC(x), BIC(x)))

  # Add a warning for the identity link
  if (x$link$link=='identity') {
    linkNote = paste('the likelihood function under the identity link can have',
                     'multiple maxima. Use the plotProfiles function to',
                     'examine the likelihood profiles near the maximum',
                     'likelihood estimate to check whether the model parameters',
                     'are credible.')
    linkNote = strwrap(linkNote, initial='\nNote: ',exdent=6)
    cat(paste(linkNote,collapse='\n'))
  }

  # Note observations dropped because of missing values
  nOmitted = length(x$na.action)
  if (nOmitted>0) {
    if (nOmitted==1) cat('\nNote: One observation omitted due to missing values.\n')
    else cat(sprintf('\nNote: %d observations omitted due to missing values.\n',nOmitted))
  }
  invisible(x)
}