Nothing
#' @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
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.