R/ltx.R
In goranbrostrom/eha: Event History Analysis
Defines functions
ltxCoef
ltx.phreg
ltx.coxreg
ltx
Documented in
ltx
#' LaTeX printing of regression results.
#'
#' This (generic) function prints the LaTeX code of the results of a fit from
#' \code{\link{coxreg}}, \code{\link{phreg}}, \code{\link{tpchreg}},
#' or \code{\link{aftreg}}, similar
#' to what \code{xtable} does for fits from other functions.
#'
#' The result is a printout which is (much) nicer than the standard printed
#' output from \code{glm} and friends,
#'
#' @param x The output from a call to \code{coxreg}, \code{tpchreg}, or
#' \code{aftreg}
#' @param caption A suitable caption for the table.
#' @param label A label used in the LaTeX code.
#' @param dr Output from a \code{drop1} call.
#' @param digits Number of digits to be printed.
#' @param \dots Not used.
#' @return LaTeX code version of the results from a run with
#' \code{\link{coxreg}}, \code{\link{phreg}}, \code{\link{phreg}},
#' or \code{\link{aftreg}}.
#' @note For printing confidence limits, use \code{\link{ltx2}}.
#' @author Göran Broström.
#' @seealso \code{\link{ltx2}}, \code{\link{coxreg}}, \code{\link{phreg}},
#' \code{\link{phreg}}, and \code{\link{aftreg}}.
#' @keywords printing
#' @examples
#'
#' data(oldmort)
#' fit <- coxreg(Surv(enter, exit, event) ~ civ + sex, data = oldmort)
#' dr <- drop1(fit, test = "Chisq")
#' ltx(fit, dr = dr, caption = "A test example.", label = "tab:test1")
#'
#' @export ltx
ltx <- function(x,
caption = NULL,
label = NULL,
dr = NULL,
digits = max(options()$digits - 4, 3), ...){
UseMethod("ltx")
}
#' @export
ltx.coxreg <- function(x, caption = NULL, label = NULL, dr = NULL,
digits=max(options()$digits - 4, 3), ...){
if (!inherits(x, "coxreg")){
stop("only for coxreg objects")
}
if (!is.null(cl<- x$call)) {
##cat("Call:\n")
##dput(cl)
##cat("\n")
}
if (!is.null(x$fail)) {
if (x$fail != 0){
cat(" coxreg failed with: ")
stop(x$fail)
}
}
if (!length(x$coefficients)){
cat("Null log likelihood = $", x$loglik[2], "$\n")
return()
}
savedig <- options(digits = digits)
on.exit(options(savedig))
ltxCoef(x, digits, dr, caption) # Print regression coefficients
### New 2020-11-26:
if (inherits(x, "summary.tpchreg")){
ivl <- paste("(", min(x$cuts), ", ", max(x$cuts), "]", sep = "")
if (x$n.strata == 1){
cat("Restr. mean survival: & ", x$rmean, " & in", ivl, "\\\\ \n")
}else{
names(x$rmean) <- x$strata
cat("Restr. mean survival in & ", ivl, ": \\\\ \n")
for (ll in 1:(x$n.strata - 1)){
cat(" & ", formatC(x$strata[ll], format = "g", flag = "#"))
}
cat(" & ", x$strata[x$n.strata], "\\\\ \n")
for (ll in 1:(x$n.strata - 1)){
cat(" & ", formatC(x$rmean[ll], format = "g", flag = "#"))
}
cat(" & ", formatC(x$rmean[x$n.strata], format = "g", flag = "#"), "\\\\ \n")
}
}
### End New 2020-11-26.
cat("\\hline \n")
cat("\\end{tabular}\n")
if (!is.null(label)){
cat("\\label{", label, "} \n", sep = "")
}
cat("\\normalsize \n")
cat("\\end{center} \n")
cat("\\end{table} \n\n\n")
cat(" \n\n")
#####################################
if(FALSE){
tmp <- cbind(coef, exp(coef), se,
signif(1 - pchisq((coef/ se)^2, 1), digits - 1))
dimnames(tmp) <- list(names(coef), c("coef", "rel. risk",
"se(coef)", "p"))
cat("\n")
prmatrix(tmp)
}
if (!is.null(x$frailty)){
cat("\nFrailty standard deviation = ", x$sigma, "\n")
cat(" S.E. = ", x$sigma.sd, "\n\n")
}
if (FALSE){
logtest <- -2 * (x$loglik[1] - x$loglik[2])
if (is.null(x$df)) df <- sum(!is.na(coef))
else df <- round(sum(x$df),2)
cat("\n")
cat(formatC("Events", width = 25, flag = "-"), x$events, "\n")
cat(formatC("Total time at risk", width = 25, flag = "-"),
formatC(x$ttr, digits = 5, format = "fg"), "\n")
cat(formatC("Max. log. likelihood", width = 25, flag = "-"),
formatC(x$loglik[2], digits = 5, format = "fg"), "\n")
cat(formatC("LR test statistic", width = 25, flag = "-"),
format(round(logtest, 2)), "\n")
cat(formatC("Degrees of freedom", width = 25, flag = "-"),
formatC(df, digits = 0, format = "f"), "\n")
cat(formatC("Overall p-value", width = 25, flag = "-"),
format.pval(1 - pchisq(logtest, df), digits = 6, "\n"))
cat("\n")
if (length(x$icc))
cat(" number of clusters=", x$icc[1],
" ICC=", format(x$icc[2:3]), "\n")
invisible(x)
}
}
#' @export
ltx.phreg <- function(x, caption = NULL, label = NULL, dr = NULL,
digits=max(options()$digits - 4, 3), ...){
if (!("phreg" %in% class(x))) stop("Only for 'phreg' output")
if (!is.null(cl<- x$call)) {
##cat("Call:\n")
##dput(cl)
##cat("\n")
}
if (!is.null(x$fail)) {
if (x$fail != 0){
cat(" phreg failed with: ")
stop(x$fail)
}
}
if (!length(x$coefficients)){
cat("Null log likelihood = ", x$loglik[2], "\n")
return()
}
if (x$pfixed){
n.slsh <- 1
}else{
n.slsh <- 2 * x$n.strata
}
savedig <- options(digits = digits)
on.exit(options(savedig))
ltxCoef(x, digits, dr, caption) # Print regression coefficients.
if (FALSE){
cat("Baseline parameters \\\\\n")
for (i in 1:n.slsh){
jup <- length(x$coef)
ss.names <- names(x$coef[(jup - n.slsh + 1):jup])
index <- index + 1
## covar.no <- covar.no + 1
cat(formatC(ss.names[i], width = 16, flag = "-"),
formatC(" & & ",
width = 8, digits = 3, format = "c"),
coef[index], " & ",
e.coef[index], " & ",
#exp(coef[index]),
se[index], " & ",
#formatC(" ", width = 1),
formatC(wald.p[index],
digits = 3,
width = digits + 2,
format = "f"), " \\\\ ",
##signif(1 - pchisq((coef/ se)^2, 1), digits - 1),
"\n")
}
}
##cat("index = ", index, "\n")
##cat("e.coef[index - 1] = ", e.coef[index - 1], "\n")
##cat("e.coef[index] = ", e.coef[index], "\n")
### The following about 'mean' is a hack!!! only for 'gompertz'!
## Later to be moved to 'aftreg.fit'
##if (x$param == "default"){
## shapen <- exp(x$coef[index])
##}else{
## shapen <- exp(-x$coef[index])
##}
##medel <- integrate(pgompertz, 0, Inf, lower.tail = FALSE,
## scale = exp(x$coef[index - 1]),
## shape = shapen)$value
##cat("Baseline mean: ", medel,
## "\\\\", "\\hline", "\n")
### End hack!
##cat("\\hline \n")
##cat("Events & ", x$n.events, " & TTR & ", x$ttr, "\\\\ \n")
##cat("Max. Log Likelihood & ", x$loglik[2], "\\\\ \\hline \n")
##cat("\\hline \n")
cat("\\end{tabular}\n")
if (!is.null(label)){
cat("\\label{", label, "} \n", sep = "")
}
cat("\\end{center} \n")
cat("\\end{table} \n\n\n")
cat(" \n\n")
#####################################
if(FALSE){
tmp <- cbind(coef, exp(coef), se,
signif(1 - pchisq((coef/ se)^2, 1), digits - 1))
dimnames(tmp) <- list(names(coef), c("coef", "rel. risk",
"se(coef)", "p"))
cat("\n")
prmatrix(tmp)
}
if (!is.null(x$frailty)){
cat("\nFrailty standard deviation = ", x$sigma, "\n")
cat(" S.E. = ", x$sigma.sd, "\n\n")
}
if (FALSE){
logtest <- -2 * (x$loglik[1] - x$loglik[2])
if (is.null(x$df)) df <- sum(!is.na(coef))
else df <- round(sum(x$df),2)
cat("\n")
cat(formatC("Events", width = 25, flag = "-"), x$events, "\n")
cat(formatC("Total time at risk", width = 25, flag = "-"),
formatC(x$ttr, digits = 5, format = "fg"), "\n")
cat(formatC("Max. log. likelihood", width = 25, flag = "-"),
formatC(x$loglik[2], digits = 5, format = "fg"), "\n")
cat(formatC("LR test statistic", width = 25, flag = "-"),
format(round(logtest, 2)), "\n")
cat(formatC("Degrees of freedom", width = 25, flag = "-"),
formatC(df, digits = 0, format = "f"), "\n")
cat(formatC("Overall p-value", width = 25, flag = "-"),
format.pval(1 - pchisq(logtest, df), digits = 6, "\n"))
cat("\n")
if (length(x$icc))
cat(" number of clusters=", x$icc[1],
" ICC=", format(x$icc[2:3]), "\n")
invisible(x)
}
}
#############################################################################
### Start of 'ltxCoef' ###
###
ltxCoef <- function(x, digits, dr, caption){
coef <- x$coef
se <- sqrt(diag(x$var))
wald.p <- formatC(1 - pchisq((coef/ se)^2, 1),
digits = digits,
format = "f")
if(is.null(coef) | is.null(se))
stop("Input is not valid")
## Check for dr:
lp <- !is.null(dr)
if (lp){
lpval <- formatC(dr[-1, 4], digits = digits, format = "f")
}
#####################################
cat("\\begin{table}[ht] \n")
if (!is.null(caption)){
cat("\\caption{", caption, "} \n", sep = "")
}
cat("\\begin{center} \n")
cat("\\footnotesize \n") # NOTE!!
cat("\\begin{tabular}{lrrrrr} \n")
cat("\\hline \n")
if (lp){
if ("aftreg" %in% x$class){
if (x$param == "default"){
cat("\\bf Covariate & \\bf Mean & \\bf Coef & \\bf Time accn. & \\bf S.E. & \\bf L-R p \\\\ \\hline\n")
}else{
cat("\\bf Covariate & \\bf Mean & \\bf Coef & \\bf Life expn. & \\bf S.E. & \\bf L-R p \\\\ \\hline\n")
}
}else{
cat("\\bf Covariate & \\bf Mean & \\bf Coef & \\bf H.R. & \\bf S.E. & \\bf L-R p \\\\ \\hline\n")
}
}else{
if ("aftreg" %in% x$class){
if (x$param == "default"){
cat("\\bf Covariate & \\bf Mean & \\bf Coef & \\bf Time accn. & \\bf S.E. & \\bf Wald p \\\\ \\hline\n")
}else{
cat("\\bf Covariate & \\bf Mean & \\bf Coef & \\bf Life expn. & \\bf S.E. & \\bf Wald p \\\\ \\hline\n")
}
}else{
cat("\\bf Covariate & \\bf Mean & \\bf Coef & \\bf H.R. & \\bf S.E. & \\bf Wald p \\\\ \\hline\n")
}
}
e.coef <- formatC(exp(coef), digits = digits, format = "f")
coef <- formatC(coef, digits = digits, format = "f")
se <- formatC(se, digits = digits, format = "f")
ett <- 1L
noll <- 0L
factors <- attr(x$terms, "factors")
resp <- attr(x$terms, "response")
row.strata <- attr(x$terms, "specials")$strata
if (!is.null(row.strata))
col.strata <- which(factors[row.strata, ] == 1)
else col.strata <- NULL
if (!is.null(col.strata)){
factors <-
attr(x$terms, "factors")[-c(resp, row.strata), -col.strata,
drop = FALSE]
}else{
factors <-
attr(x$terms, "factors")[-c(resp, row.strata), ,
drop = FALSE]
}
covar.names <- x$covars
term.names <- colnames(factors)
isF <- x$isF
ord <- attr(x$terms, "order")
if (!is.null(col.strata)) ord <- ord[-col.strata]
index <- 0
lpindx <- 0
for (term.no in 1:length(term.names)){
if (ord[term.no] == 1){
covar.no <- which(factors[, term.no] == 1)
if (isF[covar.no]){ ## Factors:
if (lp){
lpindx <- lpindx + 1
cat(covar.names[covar.no], " & & & & &",
lpval[lpindx], " \\\\ \n")
}else{
cat(covar.names[covar.no], " \\\\ \n")
}
##p <- match(covar.names[covar.no], names(data))
no.lev <- length(x$levels[[covar.no]])
x$levels[[covar.no]] <-
substring(x$levels[[covar.no]], 1, 16)
lb <- paste("\\em", x$levels[[covar.no]][1], sep = " ")
cat("\\multicolumn{1}{r}{", lb, "}",
## cat(formatC(x$levels[[covar.no]][1], width = 16, flag = "+"),
" & ",
formatC(x$w.means[[covar.no]][1],
width = 8, digits = digits, format = "f"), " & ",
noll, " & ",
ett, " & ",
"\\multicolumn{2}{c}{(reference)} \\\\ \n", sep = "")
for (lev in 2:no.lev){
##cat("lev = ", lev, "\n")
index <- index + 1
lb <- paste("\\em", x$levels[[covar.no]][lev], sep = " ")
cat("\\multicolumn{1}{r}{", lb, "}",
##cat(formatC(x$levels[[covar.no]][lev], width = 16,
## flag = "+"),
" & $",
formatC(x$w.means[[covar.no]][lev],
width = 8, digits = digits, format = "f"), "$ & $",
coef[index], "$ & $",
e.coef[index], "$ & $",
se[index], "$")
##formatC(" ", width = 9),
if (lp){
cat("\\\\ \n")
}else{
cat(" & $ ", wald.p[index],
"$ \\\\ \n", sep = "")
}
}
}else{ ## Covariates:
index <- index + 1
cat(covar.names[covar.no],
##cat(formatC(substr(covar.names[covar.no], 1, 16),
## width = 16, flag = "-"),
" & $ ",
formatC(x$w.means[[covar.no]],
width = 8, digits = digits, format = "f"),
" $ & $ ",
coef[index], " $ & $ ",
e.coef[index], " $ & $ ",
#exp(coef[index]),
se[index], " $ & $ ")
if (lp){
lpindx <- lpindx + 1
ppv <- lpval[lpindx]
}else{
ppv <- wald.p[index]
}
cat(ppv, "$ \\\\ \n")
}
}else if (ord[term.no] > 1){ ## Interactions:
cat(formatC(term.names[term.no], width = 16, flag = "-"), " \\\\ \n")
niv <- numeric(ord[term.no])
covar.no <- which(factors[, term.no] == 1)
for (i in 1:ord[term.no]){
if (isF[covar.no[i]]){
niv[i] <- length(x$levels[[covar.no[i]]]) - 1
}else{
niv[i] <- 1
}
}
stt <- index + 1
for (index in stt:(stt + prod(niv) - 1)){
vn <- sub(covar.names[covar.no[1]], "", names(coef)[index])
for (i in 1:ord[term.no]){
vn <- sub(covar.names[covar.no[i]], "", vn)
}
## cat(format(names(coef)[index], 15, "+"),
cat(formatC(" ", width = 2),
formatC(substring(vn, 1, 22), width = 22, flag = "-"),
##format(" ", 8),
" & & ",
coef[index], " & ",
e.coef[index], " & ",
se[index], " & ",
##formatC(" ", width = 9),
formatC(wald.p[index],
digits = digits,
width = digits + 2,
format = "f"),
##signif(1 - pchisq((coef[index]/ se[index])^2, 1), digits - 1),
"\\\\ \n")
}
}
}
cat("\\hline \n")
cat("Events & ", x$n.events, " & TTR & ", x$ttr, "\\\\ \n")
cat("Max. logLik. & $ ", x$loglik[2], " $ \\\\ \\hline \n")
}
goranbrostrom/eha documentation built on March 9, 2024, 11:22 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions ltxCoef ltx.phreg ltx.coxreg ltx
Documented in ltx
#' LaTeX printing of regression results.
#'
#' This (generic) function prints the LaTeX code of the results of a fit from
#' \code{\link{coxreg}}, \code{\link{phreg}}, \code{\link{tpchreg}},
#' or \code{\link{aftreg}}, similar
#' to what \code{xtable} does for fits from other functions.
#'
#' The result is a printout which is (much) nicer than the standard printed
#' output from \code{glm} and friends,
#'
#' @param x The output from a call to \code{coxreg}, \code{tpchreg}, or
#' \code{aftreg}
#' @param caption A suitable caption for the table.
#' @param label A label used in the LaTeX code.
#' @param dr Output from a \code{drop1} call.
#' @param digits Number of digits to be printed.
#' @param \dots Not used.
#' @return LaTeX code version of the results from a run with
#' \code{\link{coxreg}}, \code{\link{phreg}}, \code{\link{phreg}},
#' or \code{\link{aftreg}}.
#' @note For printing confidence limits, use \code{\link{ltx2}}.
#' @author Göran Broström.
#' @seealso \code{\link{ltx2}}, \code{\link{coxreg}}, \code{\link{phreg}},
#' \code{\link{phreg}}, and \code{\link{aftreg}}.
#' @keywords printing
#' @examples
#'
#' data(oldmort)
#' fit <- coxreg(Surv(enter, exit, event) ~ civ + sex, data = oldmort)
#' dr <- drop1(fit, test = "Chisq")
#' ltx(fit, dr = dr, caption = "A test example.", label = "tab:test1")
#'
#' @export ltx
ltx <- function(x,
caption = NULL,
label = NULL,
dr = NULL,
digits = max(options()$digits - 4, 3), ...){
UseMethod("ltx")
}
#' @export
ltx.coxreg <- function(x, caption = NULL, label = NULL, dr = NULL,
digits=max(options()$digits - 4, 3), ...){
if (!inherits(x, "coxreg")){
stop("only for coxreg objects")
}
if (!is.null(cl<- x$call)) {
##cat("Call:\n")
##dput(cl)
##cat("\n")
}
if (!is.null(x$fail)) {
if (x$fail != 0){
cat(" coxreg failed with: ")
stop(x$fail)
}
}
if (!length(x$coefficients)){
cat("Null log likelihood = $", x$loglik[2], "$\n")
return()
}
savedig <- options(digits = digits)
on.exit(options(savedig))
ltxCoef(x, digits, dr, caption) # Print regression coefficients
### New 2020-11-26:
if (inherits(x, "summary.tpchreg")){
ivl <- paste("(", min(x$cuts), ", ", max(x$cuts), "]", sep = "")
if (x$n.strata == 1){
cat("Restr. mean survival: & ", x$rmean, " & in", ivl, "\\\\ \n")
}else{
names(x$rmean) <- x$strata
cat("Restr. mean survival in & ", ivl, ": \\\\ \n")
for (ll in 1:(x$n.strata - 1)){
cat(" & ", formatC(x$strata[ll], format = "g", flag = "#"))
}
cat(" & ", x$strata[x$n.strata], "\\\\ \n")
for (ll in 1:(x$n.strata - 1)){
cat(" & ", formatC(x$rmean[ll], format = "g", flag = "#"))
}
cat(" & ", formatC(x$rmean[x$n.strata], format = "g", flag = "#"), "\\\\ \n")
}
}
### End New 2020-11-26.
cat("\\hline \n")
cat("\\end{tabular}\n")
if (!is.null(label)){
cat("\\label{", label, "} \n", sep = "")
}
cat("\\normalsize \n")
cat("\\end{center} \n")
cat("\\end{table} \n\n\n")
cat(" \n\n")
#####################################
if(FALSE){
tmp <- cbind(coef, exp(coef), se,
signif(1 - pchisq((coef/ se)^2, 1), digits - 1))
dimnames(tmp) <- list(names(coef), c("coef", "rel. risk",
"se(coef)", "p"))
cat("\n")
prmatrix(tmp)
}
if (!is.null(x$frailty)){
cat("\nFrailty standard deviation = ", x$sigma, "\n")
cat(" S.E. = ", x$sigma.sd, "\n\n")
}
if (FALSE){
logtest <- -2 * (x$loglik[1] - x$loglik[2])
if (is.null(x$df)) df <- sum(!is.na(coef))
else df <- round(sum(x$df),2)
cat("\n")
cat(formatC("Events", width = 25, flag = "-"), x$events, "\n")
cat(formatC("Total time at risk", width = 25, flag = "-"),
formatC(x$ttr, digits = 5, format = "fg"), "\n")
cat(formatC("Max. log. likelihood", width = 25, flag = "-"),
formatC(x$loglik[2], digits = 5, format = "fg"), "\n")
cat(formatC("LR test statistic", width = 25, flag = "-"),
format(round(logtest, 2)), "\n")
cat(formatC("Degrees of freedom", width = 25, flag = "-"),
formatC(df, digits = 0, format = "f"), "\n")
cat(formatC("Overall p-value", width = 25, flag = "-"),
format.pval(1 - pchisq(logtest, df), digits = 6, "\n"))
cat("\n")
if (length(x$icc))
cat(" number of clusters=", x$icc[1],
" ICC=", format(x$icc[2:3]), "\n")
invisible(x)
}
}
#' @export
ltx.phreg <- function(x, caption = NULL, label = NULL, dr = NULL,
digits=max(options()$digits - 4, 3), ...){
if (!("phreg" %in% class(x))) stop("Only for 'phreg' output")
if (!is.null(cl<- x$call)) {
##cat("Call:\n")
##dput(cl)
##cat("\n")
}
if (!is.null(x$fail)) {
if (x$fail != 0){
cat(" phreg failed with: ")
stop(x$fail)
}
}
if (!length(x$coefficients)){
cat("Null log likelihood = ", x$loglik[2], "\n")
return()
}
if (x$pfixed){
n.slsh <- 1
}else{
n.slsh <- 2 * x$n.strata
}
savedig <- options(digits = digits)
on.exit(options(savedig))
ltxCoef(x, digits, dr, caption) # Print regression coefficients.
if (FALSE){
cat("Baseline parameters \\\\\n")
for (i in 1:n.slsh){
jup <- length(x$coef)
ss.names <- names(x$coef[(jup - n.slsh + 1):jup])
index <- index + 1
## covar.no <- covar.no + 1
cat(formatC(ss.names[i], width = 16, flag = "-"),
formatC(" & & ",
width = 8, digits = 3, format = "c"),
coef[index], " & ",
e.coef[index], " & ",
#exp(coef[index]),
se[index], " & ",
#formatC(" ", width = 1),
formatC(wald.p[index],
digits = 3,
width = digits + 2,
format = "f"), " \\\\ ",
##signif(1 - pchisq((coef/ se)^2, 1), digits - 1),
"\n")
}
}
##cat("index = ", index, "\n")
##cat("e.coef[index - 1] = ", e.coef[index - 1], "\n")
##cat("e.coef[index] = ", e.coef[index], "\n")
### The following about 'mean' is a hack!!! only for 'gompertz'!
## Later to be moved to 'aftreg.fit'
##if (x$param == "default"){
## shapen <- exp(x$coef[index])
##}else{
## shapen <- exp(-x$coef[index])
##}
##medel <- integrate(pgompertz, 0, Inf, lower.tail = FALSE,
## scale = exp(x$coef[index - 1]),
## shape = shapen)$value
##cat("Baseline mean: ", medel,
## "\\\\", "\\hline", "\n")
### End hack!
##cat("\\hline \n")
##cat("Events & ", x$n.events, " & TTR & ", x$ttr, "\\\\ \n")
##cat("Max. Log Likelihood & ", x$loglik[2], "\\\\ \\hline \n")
##cat("\\hline \n")
cat("\\end{tabular}\n")
if (!is.null(label)){
cat("\\label{", label, "} \n", sep = "")
}
cat("\\end{center} \n")
cat("\\end{table} \n\n\n")
cat(" \n\n")
#####################################
if(FALSE){
tmp <- cbind(coef, exp(coef), se,
signif(1 - pchisq((coef/ se)^2, 1), digits - 1))
dimnames(tmp) <- list(names(coef), c("coef", "rel. risk",
"se(coef)", "p"))
cat("\n")
prmatrix(tmp)
}
if (!is.null(x$frailty)){
cat("\nFrailty standard deviation = ", x$sigma, "\n")
cat(" S.E. = ", x$sigma.sd, "\n\n")
}
if (FALSE){
logtest <- -2 * (x$loglik[1] - x$loglik[2])
if (is.null(x$df)) df <- sum(!is.na(coef))
else df <- round(sum(x$df),2)
cat("\n")
cat(formatC("Events", width = 25, flag = "-"), x$events, "\n")
cat(formatC("Total time at risk", width = 25, flag = "-"),
formatC(x$ttr, digits = 5, format = "fg"), "\n")
cat(formatC("Max. log. likelihood", width = 25, flag = "-"),
formatC(x$loglik[2], digits = 5, format = "fg"), "\n")
cat(formatC("LR test statistic", width = 25, flag = "-"),
format(round(logtest, 2)), "\n")
cat(formatC("Degrees of freedom", width = 25, flag = "-"),
formatC(df, digits = 0, format = "f"), "\n")
cat(formatC("Overall p-value", width = 25, flag = "-"),
format.pval(1 - pchisq(logtest, df), digits = 6, "\n"))
cat("\n")
if (length(x$icc))
cat(" number of clusters=", x$icc[1],
" ICC=", format(x$icc[2:3]), "\n")
invisible(x)
}
}
#############################################################################
### Start of 'ltxCoef' ###
###
ltxCoef <- function(x, digits, dr, caption){
coef <- x$coef
se <- sqrt(diag(x$var))
wald.p <- formatC(1 - pchisq((coef/ se)^2, 1),
digits = digits,
format = "f")
if(is.null(coef) | is.null(se))
stop("Input is not valid")
## Check for dr:
lp <- !is.null(dr)
if (lp){
lpval <- formatC(dr[-1, 4], digits = digits, format = "f")
}
#####################################
cat("\\begin{table}[ht] \n")
if (!is.null(caption)){
cat("\\caption{", caption, "} \n", sep = "")
}
cat("\\begin{center} \n")
cat("\\footnotesize \n") # NOTE!!
cat("\\begin{tabular}{lrrrrr} \n")
cat("\\hline \n")
if (lp){
if ("aftreg" %in% x$class){
if (x$param == "default"){
cat("\\bf Covariate & \\bf Mean & \\bf Coef & \\bf Time accn. & \\bf S.E. & \\bf L-R p \\\\ \\hline\n")
}else{
cat("\\bf Covariate & \\bf Mean & \\bf Coef & \\bf Life expn. & \\bf S.E. & \\bf L-R p \\\\ \\hline\n")
}
}else{
cat("\\bf Covariate & \\bf Mean & \\bf Coef & \\bf H.R. & \\bf S.E. & \\bf L-R p \\\\ \\hline\n")
}
}else{
if ("aftreg" %in% x$class){
if (x$param == "default"){
cat("\\bf Covariate & \\bf Mean & \\bf Coef & \\bf Time accn. & \\bf S.E. & \\bf Wald p \\\\ \\hline\n")
}else{
cat("\\bf Covariate & \\bf Mean & \\bf Coef & \\bf Life expn. & \\bf S.E. & \\bf Wald p \\\\ \\hline\n")
}
}else{
cat("\\bf Covariate & \\bf Mean & \\bf Coef & \\bf H.R. & \\bf S.E. & \\bf Wald p \\\\ \\hline\n")
}
}
e.coef <- formatC(exp(coef), digits = digits, format = "f")
coef <- formatC(coef, digits = digits, format = "f")
se <- formatC(se, digits = digits, format = "f")
ett <- 1L
noll <- 0L
factors <- attr(x$terms, "factors")
resp <- attr(x$terms, "response")
row.strata <- attr(x$terms, "specials")$strata
if (!is.null(row.strata))
col.strata <- which(factors[row.strata, ] == 1)
else col.strata <- NULL
if (!is.null(col.strata)){
factors <-
attr(x$terms, "factors")[-c(resp, row.strata), -col.strata,
drop = FALSE]
}else{
factors <-
attr(x$terms, "factors")[-c(resp, row.strata), ,
drop = FALSE]
}
covar.names <- x$covars
term.names <- colnames(factors)
isF <- x$isF
ord <- attr(x$terms, "order")
if (!is.null(col.strata)) ord <- ord[-col.strata]
index <- 0
lpindx <- 0
for (term.no in 1:length(term.names)){
if (ord[term.no] == 1){
covar.no <- which(factors[, term.no] == 1)
if (isF[covar.no]){ ## Factors:
if (lp){
lpindx <- lpindx + 1
cat(covar.names[covar.no], " & & & & &",
lpval[lpindx], " \\\\ \n")
}else{
cat(covar.names[covar.no], " \\\\ \n")
}
##p <- match(covar.names[covar.no], names(data))
no.lev <- length(x$levels[[covar.no]])
x$levels[[covar.no]] <-
substring(x$levels[[covar.no]], 1, 16)
lb <- paste("\\em", x$levels[[covar.no]][1], sep = " ")
cat("\\multicolumn{1}{r}{", lb, "}",
## cat(formatC(x$levels[[covar.no]][1], width = 16, flag = "+"),
" & ",
formatC(x$w.means[[covar.no]][1],
width = 8, digits = digits, format = "f"), " & ",
noll, " & ",
ett, " & ",
"\\multicolumn{2}{c}{(reference)} \\\\ \n", sep = "")
for (lev in 2:no.lev){
##cat("lev = ", lev, "\n")
index <- index + 1
lb <- paste("\\em", x$levels[[covar.no]][lev], sep = " ")
cat("\\multicolumn{1}{r}{", lb, "}",
##cat(formatC(x$levels[[covar.no]][lev], width = 16,
## flag = "+"),
" & $",
formatC(x$w.means[[covar.no]][lev],
width = 8, digits = digits, format = "f"), "$ & $",
coef[index], "$ & $",
e.coef[index], "$ & $",
se[index], "$")
##formatC(" ", width = 9),
if (lp){
cat("\\\\ \n")
}else{
cat(" & $ ", wald.p[index],
"$ \\\\ \n", sep = "")
}
}
}else{ ## Covariates:
index <- index + 1
cat(covar.names[covar.no],
##cat(formatC(substr(covar.names[covar.no], 1, 16),
## width = 16, flag = "-"),
" & $ ",
formatC(x$w.means[[covar.no]],
width = 8, digits = digits, format = "f"),
" $ & $ ",
coef[index], " $ & $ ",
e.coef[index], " $ & $ ",
#exp(coef[index]),
se[index], " $ & $ ")
if (lp){
lpindx <- lpindx + 1
ppv <- lpval[lpindx]
}else{
ppv <- wald.p[index]
}
cat(ppv, "$ \\\\ \n")
}
}else if (ord[term.no] > 1){ ## Interactions:
cat(formatC(term.names[term.no], width = 16, flag = "-"), " \\\\ \n")
niv <- numeric(ord[term.no])
covar.no <- which(factors[, term.no] == 1)
for (i in 1:ord[term.no]){
if (isF[covar.no[i]]){
niv[i] <- length(x$levels[[covar.no[i]]]) - 1
}else{
niv[i] <- 1
}
}
stt <- index + 1
for (index in stt:(stt + prod(niv) - 1)){
vn <- sub(covar.names[covar.no[1]], "", names(coef)[index])
for (i in 1:ord[term.no]){
vn <- sub(covar.names[covar.no[i]], "", vn)
}
## cat(format(names(coef)[index], 15, "+"),
cat(formatC(" ", width = 2),
formatC(substring(vn, 1, 22), width = 22, flag = "-"),
##format(" ", 8),
" & & ",
coef[index], " & ",
e.coef[index], " & ",
se[index], " & ",
##formatC(" ", width = 9),
formatC(wald.p[index],
digits = digits,
width = digits + 2,
format = "f"),
##signif(1 - pchisq((coef[index]/ se[index])^2, 1), digits - 1),
"\\\\ \n")
}
}
}
cat("\\hline \n")
cat("Events & ", x$n.events, " & TTR & ", x$ttr, "\\\\ \n")
cat("Max. logLik. & $ ", x$loglik[2], " $ \\\\ \\hline \n")
}
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.