R/print.uRegress.R In uwIntroStats: Descriptive Statistics, Inference, Regression, and Plotting in an Introductory Statistics Course

Documented in print.uRegress

```## A function to pring uRegress objects
## Args: x            - the uRegress object
##       augmented    - whether or not the object has an augmented coefficients matrix
##       digits       - the number of digits to round to
##       signif.stars - whether to print stars for significant results
##       suppress     - whether or not to suppress printing of the raw coefficients (for example, in logistic regression)
##       version      - returns only the version of the function
## Returns: a printed uRegress object
## Version: 2015 05 31
print.uRegress <-
function (x,...,augmented=TRUE,digits=max(3,getOption("digits")-3),signif.stars=FALSE, suppress, version=FALSE) {

suppress <- x\$suppress
vrsn <- "20150525"

## function to put the numbers on the names correctly
## based on the length of the coefficients matrix
## Args: str - the string vector to attach the numbers to
##      nums - the numbers vector - will have NAs
attachNums <- function(str, nums){
largeNoNa <- max(which(!is.na(nums)))
if(length(nums)<10){
tmp <- paste(ifelse(is.na(nums), rep(" ", length(explode(paste("[",nums[largeNoNa],"] ",sep=" ")))+1), paste("[",nums,"] ",sep="")), str, sep="")
} else {
tmp <- ifelse(!is.na(nums), ifelse(nums<10, paste(ifelse(is.na(nums), rep(" ", length(explode(paste("[",nums[largeNoNa],"] ",sep=" ")))+1), paste("[",nums,"] ",sep="")), str, sep=" "),
paste(ifelse(is.na(nums), rep(" ", length(explode(paste("[",nums[largeNoNa],"] ",sep=" ")))+1), paste("[",nums,"] ",sep="")), str, sep="")),
paste(rep(" ", length(explode(paste("[",nums[largeNoNa],"] ",sep=" ")))+1), str))
}
return(tmp)
}
if(!is.null(dim(x\$model))){
tmp <- dimnames(x\$model)[[1]]
tmp <- indentNames(tmp, x\$coefNums, x\$levels)
tmp <- attachNums(tmp, x\$coefNums)
dimnames(x\$model)[[1]] <- tmp
if(!is.na(x\$transformed)[1]){
dimnames(x\$transformed)[[1]] <- tmp
}
} else {
tmp <- names(x\$model)
tmp3 <- names(x\$transformed)
tmpMat <- matrix(x\$model, nrow=1)
tmpMat2 <- matrix(x\$transformed, nrow=1)
tmp2 <- dimnames(x\$model)[[1]]
tmp2 <- indentNames(tmp2, x\$coefNums, x\$levels)
tmp2 <- attachNums(tmp2, x\$coefNums)
x\$model <- tmpMat
x\$transformed <- tmpMat2
dimnames(x\$model) <- list(tmp2, tmp)
dimnames(x\$transformed) <- list(tmp2,tmp3)
}
if (version) return(vrsn)
printerLm <- function (x, digits = max(3L, getOption("digits") - 3L), symbolic.cor = x\$symbolic.cor,
signif.stars = getOption("show.signif.stars"), suppress, ...)
{
if(!is.null(x\$augmented)){
augmented <- x\$augmented
} else{
augmented <- FALSE
}
cat("\nCall:\n", paste(deparse(x\$call), sep = "\n", collapse = "\n"),
"\n\n", sep = "")
resid <- x\$residuals
df <- x\$df
rdf <- df[2L]
if(!is.null(resid)){
cat(if (!is.null(x\$weights) && diff(range(x\$weights)))
"Weighted ", "Residuals:\n", sep = "")
if (rdf > 5L) {
nam <- c("Min", "1Q", "Median", "3Q", "Max")
rq <- if (length(dim(resid)) == 2L)
structure(apply(t(resid), 1L, quantile), dimnames = list(nam,
dimnames(resid)[[2L]]))
else {
zz <- zapsmall(quantile(resid), digits + 1L)
structure(zz, names = nam)
}
print(rq, digits = digits, ...)
}
else if (rdf > 0L) {
print(resid, digits = digits, ...)
}
else {
cat("ALL", df[1L], "residuals are 0: no residual degrees of freedom!")
cat("\n")
}
}
if (length(x\$aliased) == 0L) {
cat("\nNo Coefficients\n")
}
else {
if (nsingular <- df[3L] - df[1L])
cat("\nCoefficients: (", nsingular, " not defined because of singularities)\n",
sep = "")
else cat("\nCoefficients:\n")
coefs <- x\$coefficients

if(augmented){
if(is.na(x\$transformed[1])){
print.augCoefficients(x\$model)
} else if (suppress){
cat("\nTransformed Model:\n")
print.augCoefficients(x\$transformed)
} else {
cat("\nRaw Model:\n")
print.augCoefficients(x\$model)
cat("\nTransformed Model:\n")
print.augCoefficients(x\$transformed)
}
} else{
if(is.na(x\$transformed[1])){
printCoefmat(x\$model, digits = digits, signif.stars = signif.stars,
na.print = "NA", ...)
} else if (suppress){
cat("\n Transformed Model: \n")
printCoefmat(x\$transformed, digits = digits, signif.stars = signif.stars,
na.print = "NA", ...)
} else {
cat("\n Raw Model: \n")
printCoefmat(x\$model, digits = digits, signif.stars = signif.stars,
na.print = "NA", ...)
cat("\n Transformed Model: \n")
printCoefmat(x\$transformed, digits = digits, signif.stars = signif.stars,
na.print = "NA", ...)

}
}
}
for(i in 1:length(x\$args)){
if(is.list(x\$args[[i]])){
if(x\$args[[i]]\$transformation=="polynomial"){
cat("\n", paste("Polynomial terms calculated from ", x\$args[[i]]\$nm, ", centered at ",round(x\$args[[i]]\$center, digits), sep=""),  "\n")
} else if (x\$args[[i]]\$transformation=="lspline"){
cat("\n", paste("Linear Spline terms calculated from ", x\$args[[i]]\$nm, ", knots = ",paste(x\$args[[i]]\$knots, collapse=","),", param = ", x\$args[[i]]\$param, sep=""), "\n")
} else {
cat("\n", paste("Dummy terms calculated from ", x\$args[[i]]\$nm, ", reference = ",x\$args[[i]]\$reference,sep=""), "\n")
}
}
}
if(any(x\$dropped)){
cat("\n", "Predictor(s) dropped due to overfitting", "\n")
}
if(!is.null(x\$sigma)){
cat("\nResidual standard error:", format(signif(x\$sigma,
digits)), "on", rdf, "degrees of freedom")
cat("\n")
if (nzchar(mess <- naprint(x\$na.action)))
cat("  (", mess, ")\n", sep = "")
if (!is.null(x\$fstatistic)) {
cat("Multiple R-squared: ", formatC(x\$r.squared, digits = digits))
digits = digits), "\nF-statistic:", formatC(x\$fstatistic[1L],
digits = digits), "on", x\$fstatistic[2L], "and",
x\$fstatistic[3L], "DF,  p-value:", format.pval(pf(x\$fstatistic[1L],
x\$fstatistic[2L], x\$fstatistic[3L], lower.tail = FALSE),
digits = digits))
cat("\n")
}
correl <- x\$correlation
if (!is.null(correl)) {
p <- NCOL(correl)
if (p > 1L) {
cat("\nCorrelation of Coefficients:\n")
if (is.logical(symbolic.cor) && symbolic.cor) {
print(symnum(correl, abbr.colnames = NULL))
}
else {
correl <- format(round(correl, 2), nsmall = 2,
digits = digits)
correl[!lower.tri(correl)] <- ""
print(correl[-1, -p, drop = FALSE], quote = FALSE)
}
}
}
}

cat("\n")
invisible(x)
}
printerGlm <- function (x, digits = max(3L, getOption("digits") - 3L), symbolic.cor = x\$symbolic.cor,
signif.stars = getOption("show.signif.stars"), suppress, ...)
{
if(!is.null(x\$augmented)){
augmented <- x\$augmented
} else{
augmented <- FALSE
}
cat("\nCall:\n", paste(deparse(x\$call), sep = "\n", collapse = "\n"),
"\n\n", sep = "")
cat("Deviance Residuals: \n")
if (x\$df.residual > 5) {
x\$deviance.resid <- setNames(quantile(x\$deviance.resid,
na.rm = TRUE), c("Min", "1Q", "Median", "3Q", "Max"))
}
xx <- zapsmall(x\$deviance.resid, digits + 1L)
print.default(xx, digits = digits, na.print = "", print.gap = 2L)
if (length(x\$aliased) == 0L) {
cat("\nNo Coefficients\n")
}
else {
df <- if ("df" %in% names(x))
x[["df"]]
else NULL
if (!is.null(df) && (nsingular <- df[3L] - df[1L]))
cat("\nCoefficients: (", nsingular, " not defined because of singularities)\n",
sep = "")
else cat("\nCoefficients:\n")
if(augmented){
if(is.na(x\$transformed[1])){
print.augCoefficients(x\$model)
} else if (suppress){
cat("\nTransformed Model:\n")
print.augCoefficients(x\$transformed)
} else {
cat("\nRaw Model:\n")
print.augCoefficients(x\$model)
cat("\nTransformed Model:\n")
print.augCoefficients(x\$transformed)
}
} else{
if(is.na(x\$transformed[1])){
printCoefmat(x\$model, digits = digits, signif.stars = signif.stars,
na.print = "NA", ...)
} else if (suppress){
cat("\nTransformed Model:\n")
printCoefmat(x\$transformed, digits = digits, signif.stars = signif.stars,
na.print = "NA", ...)
} else {
cat("\nRaw Model:\n")
printCoefmat(x\$model, digits = digits, signif.stars = signif.stars,
na.print = "NA", ...)
cat("\nTransformed Model:\n")
printCoefmat(x\$transformed, digits = digits, signif.stars = signif.stars,
na.print = "NA", ...)

}
}
}
for(i in 1:length(x\$args)){
if(is.list(x\$args[[i]])){
if(x\$args[[i]]\$transformation=="polynomial"){
cat("\n", paste("Polynomial terms calculated from ", x\$args[[i]]\$nm, ", centered at ",round(x\$args[[i]]\$center, digits), sep=""),  "\n")
} else if (x\$args[[i]]\$transformation=="lspline"){
cat("\n", paste("Linear Spline terms calculated from ", x\$args[[i]]\$nm, ", knots = ",x\$args[[i]]\$knots,", param = ", x\$args[[i]]\$param, sep=""), "\n")
} else {
cat("\n", paste("Dummy terms calculated from ", x\$args[[i]]\$nm, ", reference = ",x\$args[[i]]\$reference,sep=""), "\n")
}
}
}
if(any(x\$dropped)){
cat("\n", "Predictor(s) dropped due to overfitting", "\n")
}
cat("\n(Dispersion parameter for ", x\$family\$family, " family taken to be ",
format(x\$dispersion), ")\n\n", apply(cbind(paste(format(c("Null",
"Residual"), justify = "right"), "deviance:"), format(unlist(x[c("null.deviance",
"deviance")]), digits = max(5L, digits + 1L)), " on",
format(unlist(x[c("df.null", "df.residual")])), " degrees of freedom\n"),
1L, paste, collapse = " "), sep = "")
if (nzchar(mess <- naprint(x\$na.action)))
cat("  (", mess, ")\n", sep = "")
cat("AIC: ", format(x\$aic, digits = max(4L, digits + 1L)),
"\n\n", "Number of Fisher Scoring iterations: ", x\$iter,
"\n", sep = "")
correl <- x\$correlation
if (!is.null(correl)) {
p <- NCOL(correl)
if (p > 1) {
cat("\nCorrelation of Coefficients:\n")
if (is.logical(symbolic.cor) && symbolic.cor) {
print(symnum(correl, abbr.colnames = NULL))
}
else {
correl <- format(round(correl, 2L), nsmall = 2L,
digits = digits)
correl[!lower.tri(correl)] <- ""
print(correl[-1, -p, drop = FALSE], quote = FALSE)
}
}
}
cat("\n")
invisible(x)
}
f.PH <- function (x, digits = max(getOption("digits") - 3, 3), signif.stars = getOption("show.signif.stars"), suppress, ...) {

if (!is.null(x\$call)) {
cat("Call:\n")
dput(x\$call)
cat("\n")
}
if (!is.null(x\$fail)) {
cat(" Coxreg failed.", x\$fail, "\n")
return()
}
savedig <- options(digits = digits)
on.exit(options(savedig))
omit <- x\$na.action
cat("  n=", x\$n)
if (!is.null(x\$nevent))
cat(", number of events=", x\$nevent, "\n")
else cat("\n")
if (length(omit))
cat("   (", naprint(omit), ")\n", sep = "")
if (nrow(x\$coefficients) == 0) {
cat("   Null model\n")
return()
}
if(augmented){
if(is.na(x\$transformed[1])){
print.augCoefficients(x\$model)
} else if (suppress){
cat("\nTransformed Model:\n")
print.augCoefficients(x\$transformed)
} else {
cat("\nRaw Model:\n")
print.augCoefficients(x\$model)
cat("\nTransformed Model:\n")
print.augCoefficients(x\$transformed)
}
} else {
if(is.na(x\$transformed[1])){
printCoefmat(x\$model, digits = digits, signif.stars = signif.stars,
na.print = "NA", ...)
} else if (suppress){
cat("\nTransformed Model:\n")
printCoefmat(x\$transformed, digits = digits, signif.stars = signif.stars,
na.print = "NA", ...)
} else {
cat("\nRaw Model:\n")
printCoefmat(x\$model, digits = digits, signif.stars = signif.stars,
na.print = "NA", ...)
cat("\nTransformed Model:\n")
printCoefmat(x\$transformed, digits = digits, signif.stars = signif.stars,
na.print = "NA", ...)

}
}

## for each one, print the correct stuff
for(i in 1:length(x\$args)){
if(is.list(x\$args[[i]])){
if(x\$args[[i]]\$transformation=="polynomial"){
cat("\n", paste("Polynomial terms calculated from ", x\$args[[i]]\$nm, ", centered at ",round(x\$args[[i]]\$center, digits), sep=""),  "\n")
} else if (x\$args[[i]]\$transformation=="lspline"){
cat("\n", paste("Linear Spline terms calculated from ", x\$args[[i]]\$nm, ", knots = ",x\$args[[i]]\$knots,", param = ", x\$args[[i]]\$param, sep=""), "\n")
} else {
cat("\n", paste("Dummy terms calculated from ", x\$args[[i]]\$nm, ", reference = ",x\$args[[i]]\$reference,sep=""), "\n")
}
}
}
if(any(x\$dropped)){
cat("\n", "Predictor(s) dropped due to overfitting", "\n")
}
cat("\n")
if (!is.null(x\$concordance)) {
cat("Concordance=", format(round(x\$concordance[1], 3)),
" (se =", format(round(x\$concordance[2], 3)), ")\n")
}
cat("Rsquare=", format(round(x\$rsq["rsq"], 3)), "  (max possible=",
format(round(x\$rsq["maxrsq"], 3)), ")\n")
cat("Likelihood ratio test= ", format(round(x\$logtest["test"],
2)), "  on ", x\$logtest["df"], " df,", "   p=", format(x\$logtest["pvalue"]),
"\n", sep = "")
cat("Wald test            = ", format(round(x\$waldtest["test"],
2)), "  on ", x\$waldtest["df"], " df,", "   p=", format(x\$waldtest["pvalue"]),
"\n", sep = "")
cat("Score (logrank) test = ", format(round(x\$sctest["test"],
2)), "  on ", x\$sctest["df"], " df,", "   p=", format(x\$sctest["pvalue"]),
sep = "")
if (is.null(x\$robscore))
cat("\n\n")
else cat(",   Robust = ", format(round(x\$robscore["test"],
2)), "  p=", format(x\$robscore["pvalue"]), "\n\n", sep = "")
if (x\$used.robust)
cat("  (Note: the likelihood ratio and score tests",
"assume independence of\n     observations within a cluster,",
"the Wald and robust score tests do not).\n")
invisible()
}
printerGEE <- function(x, digits = max(getOption("digits") - 3, 3), signif.stars = getOption("show.signif.stars"), suppress, ...){
if(!is.null(x\$augmented)){
augmented <- x\$augmented
} else{
augmented <- FALSE
}
cat("\nCall:\n", paste(deparse(x\$call), sep = "\n", collapse = "\n"),
"\n\n", sep = "")
cat("Deviance Residuals: \n")
if (length(x\$deviance.resid) > 5) {
x\$deviance.resid <- setNames(quantile(x\$deviance.resid,
na.rm = TRUE), c("Min", "1Q", "Median", "3Q", "Max"))
}
xx <- zapsmall(x\$deviance.resid, digits + 1L)
print.default(xx, digits = digits, na.print = "", print.gap = 2L)
if (length(x\$aliased) == 0L) {
cat("\nNo Coefficients\n")
}else {
df <- if ("df" %in% names(x))
x[["df"]]
else NULL
if (!is.null(df) && (nsingular <- df[3L] - df[1L]))
cat("\nCoefficients: (", nsingular, " not defined because of singularities)\n",
sep = "")
else cat("\nCoefficients:\n")
if(augmented){
if(is.na(x\$transformed[1])){
print.augCoefficients(x\$model)
} else if (suppress){
cat("\nTransformed Model:\n")
print.augCoefficients(x\$transformed)
} else {
cat("\nRaw Model:\n")
print.augCoefficients(x\$model)
cat("\nTransformed Model:\n")
print.augCoefficients(x\$transformed)
}
} else{
if(is.na(x\$transformed[1])){
printCoefmat(x\$model, digits = digits, signif.stars = signif.stars,
na.print = "NA", ...)
} else if (suppress){
cat("\nTransformed Model:\n")
printCoefmat(x\$transformed, digits = digits, signif.stars = signif.stars,
na.print = "NA", ...)
} else {
cat("\nRaw Model:\n")
printCoefmat(x\$model, digits = digits, signif.stars = signif.stars,
na.print = "NA", ...)
cat("\nTransformed Model:\n")
printCoefmat(x\$transformed, digits = digits, signif.stars = signif.stars,
na.print = "NA", ...)

}
}
}
## for each one, print the correct stuff
for(i in 1:length(x\$args)){
if(is.list(x\$args[[i]])){
if(x\$args[[i]]\$transformation=="polynomial"){
cat("\n", paste("Polynomial terms calculated from ", x\$args[[i]]\$nm, ", centered at ",round(x\$args[[i]]\$center, digits), sep=""),  "\n")
} else if (x\$args[[i]]\$transformation=="lspline"){
cat("\n", paste("Linear Spline terms calculated from ", x\$args[[i]]\$nm, ", knots = ",x\$args[[i]]\$knots,", param = ", x\$args[[i]]\$param, sep=""), "\n")
} else {
cat("\n", paste("Dummy terms calculated from ", x\$args[[i]]\$nm, ", reference = ",x\$args[[i]]\$reference,sep=""), "\n")
}
}
}
if(any(x\$dropped)){
cat("\n", "Predictor(s) dropped due to overfitting", "\n")
}
cat("\n Estimated Scale Parameters: \n")
print(format(x\$dispersion))

cat("\n Correlation: Structure = ", x\$corstr, "\n")
cat("\n Number of Clusters: ", length(x\$clusz), "\n")
cat("\n Maximum Cluster Size: ", max(x\$clusz), "\n")
cat("\n")
invisible(x)
}
x\$augmented <- augmented
x\$suppress <- suppress
#	cat("n =",x\$n)
if(!is.null(x\$na.action)) {
cat("(",length(x\$na.action)," cases deleted due to missing values)")
cat("\n\n")
}
if(!x\$anyRepeated | x\$fnctl =="hazard"){
if (x\$fnctl %in% c("mean","geometric mean")) {
#f <- getAnywhere(print.summary.lm)\$objs[[1]]
f <- printerLm
} else if (x\$fnctl == "hazard") {
f <- f.PH
} else f <- printerGlm
} else {
f <- printerGEE
}
if (augmented) {
x\$coefficients <- x\$augCoefficients
x\$conf.int <- NULL
}
f(x,digits=digits,signif.stars=signif.stars, suppress=suppress)
}
```

Try the uwIntroStats package in your browser

Any scripts or data that you put into this service are public.

uwIntroStats documentation built on Oct. 10, 2018, 5:04 p.m.