R/print_imprecise.R

In ipeglim: Imprecise Inferential Framework on Statistical Reasoning

#' @aliases 
#' print print.imprecise print.summary.imprecise
#'
#' @title 
#' Printing Imprecise Class Objects
#'
#' @description
#' The function \code{print.imprecise} is the \code{imprecise} method of the 
#' generic function \code{print} which displays summaries produced from
#' two classes of \code{imprecise} for an imprecise prior and
#' \code{summary.imprecise} for an imprecise posterior.
#' 
#' @param x 
#' the object of classes \code{imprecise} or \code{summary.imprecise}.
#' 
#' @param ... 
#' further arugments to be passed to \code{print}.
#' 
#' @references
#' Lee (2013) ``Imprecise inferential framework'', PhD thesis.
#'
#' @author Chel Hee Lee <\email{gnustats@@gmail.com}>
#' @method print imprecise
#' @S3method print imprecise 
print.imprecise <- function(x, ...){
  
  if (is.na(x$stage)) {
		
		message("Coordinates of extreme points are:")
		print(do.call(rbind, x$xtms))
  } else { 
  
  if (x$stage == "model") {
  
    message("Preliminary analysis for imprecise inferential framework:")
    cat("Call:", deparse(x$formula), "\n")
    
    message("\nModel is selected with options of \n",
            "ztrunc= ", sQuote(x$ztrunc),
            ", dist= ", sQuote(x$dist), 
            ", link= ", sQuote("log"), ".\n")
    print(summary(x$fit))
  }
  
  if (x$stage == "iprior") {
  
    message("Coordinate information of imprecise prior is as follow:")
    tab <- do.call(rbind, x$xtms)
    printCoefmat(tab, tst.ind=seq_len(ncol(tab)))

    message("\nGiven constraint information is as follow:")
    print(unlist(x$constraints))
    
    if(x$m0shape %in% c("circle2d", "sphere3d")) {
      message("\nNOTE: \n",
              "Numbers of dimensions for this type of imprecise prior is \n",
              sQuote("2 (circle)"), " or ", sQuote("3 (sphere)"), ". ",
              "Please consult with ", sQuote("help(iprior)"), ".")
    }
  }
  
  if (x$stage=="update") {
  
    if (x$xreg) {
      message("Imprecise prior is updated with options of\n",
              "ztrunc= ", sQuote(x$ztrunc), 
              ", method= ", sQuote(x$method), 
              ", apriori= ", sQuote(x$apriori), "\n")
      message("The model is specified as ", sQuote(deparse(x$formula)), 
              " called with\n", 
              "the covariance structure on the imprecise prior:")
      print(x$B)
          
      message("\nPlease use ", sQuote("summary()"), 
              " to see all available summaries.")
    }
  }

	} # end of is.na(x$stage) 
  
}
NULL

#' @rdname print.imprecise
#' @method print summary.imprecise
#' @S3method print summary.imprecise
print.summary.imprecise <- function(x, ...){

  ## naming conventions
  xtms <- do.call(rbind, x$xtms)
  xreg <- x$xreg
  ztrunc <- x$ztrunc
  method <- x$method
  formula <- x$formula
  y <- x$y
  X <- x$X
  xi <- x$xi
  m1 <- x$m1
  apriori <- x$apriori
  est <- x$est
  N <- x$N
  HT.est <- x$HT.est
  apriori <- x$apriori

  if (ztrunc) {
    name.model <- "Zero-Truncated"
  } else {
    name.model <- "Ordinary"
  }
  
  if (xreg) {
    m2reg <- "Regression"
  } else {
    m2reg <- ""
  }
  
  name.apriori <- switch(apriori,
    "lgamma" = "Log-Gamma",
    "normal" = "Normal")
  
  name.method <- switch(method, 
    "LA" = "Laplace approximation", 
    "IS" = "Importance sampling", 
    "MH" = "Metropolis-Hastings algorithm",
    "AQ" = "Adaptive Quadrature", 
    "AS" = "Analytic Solution")
  
  if (xreg) {
    name.cpar <- sQuote("beta")
  } else {
    name.cpar <- sQuote("theta")
  }
  
  message(name.model, " Poisson ", m2reg, " model is fitted\n", 
          "with a ", sQuote("log"), "-link function.")
  print(formula)
  
  if (xreg) {
    message("\nEstimates of ", sQuote("beta"))
  } else {
    message("\nEstimates of ", sQuote("theta"))
  }

  if (xreg) {
    tab <- est
    showIdx <- min(5, nrow(est))
    tab <- tab[seq_len(showIdx),]
    printCoefmat(tab, tst.ind=seq_len(ncol(tab)))
  } else {
  
    if (HT.est) {
      tab <- cbind(est, exp(est), N)
      colnames(tab) <- c("theta", "exp(theta)", "N")
    } else {
      tab <- cbind(est, exp(est)) 
      colnames(tab) <- c("theta", "exp(theta)")
    }
 
    showIdx <- min(5, length(est))
    tab <- tab[seq_len(showIdx), ]
    printCoefmat(tab, tst.ind=seq_len(ncol(tab)))
  
  }

  if (nrow(tab)>5) {
    message("NOTE: The first five estimates are printed.\n")
  }
  
  message("\n", name.apriori, " imprecise prior is applied to the model.")
  message(name.method, " is employed \n", 
          "for numerical approximation.")
  message("Please use ", sQuote("attributes()")," to check the names of \n",
          "other available summaries.")  
  invisible(x)
}
NULL