.onAttach <-
function(libname, pkgname) {
packageStartupMessage("\nPlease cite as: \n")
packageStartupMessage(" Hlavac, Marek (2022). stargazer: Well-Formatted Regression and Summary Statistics Tables.")
packageStartupMessage(" R package version 5.2.3. https://CRAN.R-project.org/package=stargazer \n")
}
.stargazer.wrap <-
function(..., type, title, style, summary, out, out.header, covariate.labels, column.labels, column.separate,
dep.var.caption, dep.var.labels, dep.var.labels.include, align, coef, se, t, p, t.auto,
p.auto, ci, ci.custom, ci.level, ci.separator, add.lines, apply.coef, apply.se, apply.t, apply.p, apply.ci,
colnames,
column.sep.width, decimal.mark, df, digit.separate, digit.separator, digits, digits.extra,
flip, float,
float.env, font.size, header, initial.zero, intercept.bottom, intercept.top, keep, keep.stat,
label, model.names, model.numbers, multicolumn, no.space, notes, notes.align, notes.append,
notes.label, object.names, omit, omit.labels, omit.stat, omit.summary.stat, omit.table.layout,
omit.yes.no, order, ord.intercepts, perl, report, rownames,
rq.se, selection.equation, single.row, star.char, star.cutoffs, suppress.errors,
table.layout, table.placement,
zero.component, summary.logical, summary.stat, nobs, mean.sd, min.max, median, iqr, warn) {
.add.model <-
function(object.name, user.coef=NULL, user.se=NULL, user.t=NULL, user.p=NULL, auto.t=TRUE, auto.p=TRUE, user.ci.lb=NULL, user.ci.rb=NULL) {
if (class(object.name)[1] == "Glm") {
.summary.object <<- summary.glm(object.name)
}
else if (!(.model.identify(object.name) %in% c("aftreg", "coxreg","phreg","weibreg", "Glm", "bj", "cph", "lrm", "ols", "psm", "Rq"))) {
.summary.object <<- summary(object.name)
}
else {
.summary.object <<- object.name
}
if (.model.identify(object.name) == "rq") {
.summary.object <<- suppressMessages(summary(object.name, se=.format.rq.se))
}
model.num.total <- 1 # model number for multinom, etc.
if (.model.identify(object.name) == "multinom") {
if (!is.null(nrow(.summary.object$coefficients))) {
model.num.total <- nrow(.summary.object$coefficients)
}
}
for (model.num in 1:model.num.total) {
.global.models <<- append(.global.models, .model.identify(object.name))
.global.dependent.variables <<- append(.global.dependent.variables, .dependent.variable(object.name, model.num))
.global.dependent.variables.written <<- append(.global.dependent.variables.written, .dependent.variable.written(object.name, model.num))
.global.N <<- append(.global.N, .number.observations(object.name))
.global.LL <<- append(.global.LL, .log.likelihood(object.name))
.global.R2 <<- append(.global.R2, .r.squared(object.name))
.global.max.R2 <<- append(.global.max.R2, .max.r.squared(object.name))
.global.adj.R2 <<- append(.global.adj.R2, .adj.r.squared(object.name))
.global.AIC <<- append(.global.AIC, .AIC(object.name))
.global.BIC <<- append(.global.BIC, .BIC(object.name))
.global.scale <<- append(.global.scale, .get.scale(object.name))
.global.UBRE <<- append(.global.UBRE, .gcv.UBRE(object.name))
.global.sigma2 <<- append(.global.sigma2, .get.sigma2(object.name))
.global.rho <<- cbind(.global.rho, .get.rho(object.name))
.global.mills <<- cbind(.global.mills, .get.mills(object.name))
.global.theta <<- cbind(.global.theta, .get.theta(object.name))
.global.SER <<- cbind(.global.SER, .SER(object.name))
.global.F.stat <<- cbind(.global.F.stat, .F.stat(object.name))
.global.chi.stat <<- cbind(.global.chi.stat, .chi.stat(object.name))
.global.wald.stat <<- cbind(.global.wald.stat, .wald.stat(object.name))
.global.lr.stat <<- cbind(.global.lr.stat, .lr.stat(object.name))
.global.logrank.stat <<- cbind(.global.logrank.stat, .logrank.stat(object.name))
.global.null.deviance <<- cbind(.global.null.deviance, .null.deviance(object.name))
.global.residual.deviance <<- cbind(.global.residual.deviance, .residual.deviance(object.name))
max.length <- length(.global.coefficient.variables)+length(.coefficient.variables(object.name))
# add RHS variables and coefficients
coef.var <- .coefficient.variables(object.name)
.global.coef.vars.by.model <<- cbind(.global.coef.vars.by.model, coef.var)
temp.gcv <- rep(NA,each=1,times=max.length)
temp.gcv[1:length(.global.coefficient.variables)] <- .global.coefficient.variables
how.many.gcv <- length(.global.coefficient.variables)
# try to find variable
position <- 0
for (i in seq(1:length(coef.var))) {
found <- FALSE
for (j in seq(1:length(.global.coefficient.variables))) {
if (coef.var[i] == .global.coefficient.variables[j]) {
found <- TRUE
for (k in 1:how.many.gcv) {
if (coef.var[i]==temp.gcv[k]) {
position <- k
}
}
}
}
# If variable was found, no need to add it
if (found == FALSE) {
# append new variable to list of regressors
while ((position < how.many.gcv) && (!(temp.gcv[position+1] %in% coef.var))) {
position <- position + 1
}
temp.gcv <- append(temp.gcv, coef.var[i], after=position)
how.many.gcv <- how.many.gcv + 1
position <- position + 1
}
}
.global.coefficient.variables <<- temp.gcv[1:how.many.gcv]
# build up coefficients from scratch
temp.coefficients <- temp.std.errors <- temp.ci.lb <- temp.ci.rb <- temp.t.stats <- temp.p.values <- matrix(data = NA, nrow = length(.global.coefficient.variables), ncol = ncol(.global.coefficients)+1)
rownames(temp.coefficients) <- rownames(temp.std.errors) <- rownames(temp.ci.lb) <- rownames(temp.ci.rb) <- rownames(temp.t.stats) <- rownames(temp.p.values) <- .global.coefficient.variables
# fill in from previous iteration of .global coefficients
which.variable <- 0
for (row in .global.coefficient.variables) {
which.variable <- which.variable + 1
row.i <- .rename.intercept(row) # row with intercept renamed to get the omit and keep right
### if omitted variable, then advance to the next iteration of the loop --- !!! do this also for index
#skip all of this if omitted based on regular expression
omitted <- FALSE
if (!is.null(.format.omit.regexp)) {
for (i in seq(1:length(.format.omit.regexp))) {
if (length(grep(.format.omit.regexp[i], row.i, perl=.format.perl, fixed=FALSE))!=0) { omitted <- TRUE }
}
}
if (!is.null(.format.keep.regexp)) {
omitted <- TRUE
for (i in seq(1:length(.format.keep.regexp))) {
if (length(grep(.format.keep.regexp[i], row.i, perl=.format.perl, fixed=FALSE))!=0) { omitted <- FALSE }
}
}
if (!is.null(.format.omit.index)) {
for (i in seq(1:length(.format.omit.index))) {
if (.format.omit.index[i] == which.variable) { omitted <- TRUE }
}
}
if (!is.null(.format.keep.index)) {
omitted <- TRUE
for (i in seq(1:length(.format.keep.index))) {
if (.format.keep.index[i] == which.variable) { omitted <- FALSE }
}
}
if (omitted == TRUE) { next }
###
for (col in seq(1:ncol(.global.coefficients))) {
if (sum(as.vector(rownames(.global.coefficients[,col, drop=FALSE])==row))!=0) {
if (!is.null(.global.coefficients)) { temp.coefficients[row, col] <- .global.coefficients[row, col] }
if (!is.null(.global.std.errors)) { temp.std.errors[row, col] <- .global.std.errors[row, col] }
if (!is.null(.global.ci.lb)) { temp.ci.lb[row, col] <- .global.ci.lb[row, col] }
if (!is.null(.global.ci.rb)) { temp.ci.rb[row, col] <- .global.ci.rb[row, col] }
if (!is.null(.global.t.stats)) { temp.t.stats[row, col] <- .global.t.stats[row, col] }
if (!is.null(.global.p.values)) { temp.p.values[row, col] <- .global.p.values[row, col] }
}
}
feed.coef <- NA; feed.se <- NA
# coefficients and standard errors
if (!is.null(.get.coefficients(object.name, user.coef, model.num=model.num)[row])) {
temp.coefficients[row, ncol(temp.coefficients)] <- .get.coefficients(object.name, user.coef, model.num=model.num)[row]
feed.coef <- temp.coefficients[, ncol(temp.coefficients)]
}
if (!is.null(.get.standard.errors(object.name, user.se, model.num=model.num)[row])) {
temp.std.errors[row, ncol(temp.std.errors)] <- .get.standard.errors(object.name, user.se, model.num=model.num)[row]
feed.se <- temp.std.errors[, ncol(temp.std.errors)]
}
# confidence interval, left and right bound
if (!is.null(.get.ci.lb(object.name, user.ci.lb, model.num=model.num)[row])) { temp.ci.lb[row, ncol(temp.ci.lb)] <- .get.ci.lb(object.name, user.ci.lb, model.num=model.num)[row] }
if (!is.null(.get.ci.rb(object.name, user.ci.rb, model.num=model.num)[row])) { temp.ci.rb[row, ncol(temp.ci.rb)] <- .get.ci.rb(object.name, user.ci.rb, model.num=model.num)[row] }
# t-stats and p-values
#if (!is.null(user.coef)) { feed.coef <- user.coef } # feed user-defined coefficients, if available - check that this does not mess up multinom
#if (!is.null(user.se)) { feed.se <- user.se } # feed user-defined std errors, if available
if (!is.null(.get.t.stats(object.name, user.t, auto.t, feed.coef, feed.se, user.coef, user.se, model.num=model.num)[row])) { temp.t.stats[row, ncol(temp.std.errors)] <- .get.t.stats(object.name, user.t, auto.t, feed.coef, feed.se, user.coef, user.se, model.num=model.num)[row] }
if (!is.null(.get.p.values(object.name, user.p, auto.p, feed.coef, feed.se, user.coef, user.se, model.num=model.num)[row])) { temp.p.values[row, ncol(temp.std.errors)] <- .get.p.values(object.name, user.p, auto.p, feed.coef, feed.se, user.coef, user.se, model.num=model.num)[row] }
}
if (!is.null(temp.coefficients)) { .global.coefficients <<- temp.coefficients }
if (!is.null(temp.std.errors)) { .global.std.errors <<- temp.std.errors }
if (!is.null(temp.ci.lb)) { .global.ci.lb <<- temp.ci.lb }
if (!is.null(temp.ci.rb)) { .global.ci.rb <<- temp.ci.rb }
if (!is.null(temp.t.stats)) { .global.t.stats <<- temp.t.stats }
if (!is.null(temp.p.values)) { .global.p.values <<- temp.p.values }
}
}
.adj.r.squared <-
function(object.name) {
model.name <- .get.model.name(object.name)
if (!(model.name %in% c("arima","fGARCH","Arima","coeftest","maBina", "lmer", "glmer", "nlmer", "Gls"))) {
if (model.name %in% c("heckit")) {
return(.summary.object$rSquared$R2adj)
}
if (model.name %in% c("felm")) {
return(.summary.object$r2adj)
}
if (!is.null(suppressMessages(.summary.object$adj.r.squared))) {
return(as.vector(suppressMessages(.summary.object$adj.r.squared)))
}
else if (model.name %in% c("normal.gam", "logit.gam", "probit.gam", "poisson.gam", "gam()")) {
return(as.vector(.summary.object$r.sq))
}
else if (model.name %in% c("plm")) {
return(as.vector(.summary.object$r.squared["adjrsq"]))
}
else if (model.name %in% c("ols")) {
n <- nobs(object.name)
p <- length(object.name$coefficients[names(object.name$coefficients)!="Intercept"])
r2 <- object.name$stats["R2"]
adj.r2 <- 1-(1-r2)*((n-1) / (n-p-1))
return(as.vector(adj.r2))
}
}
return(NA)
}
.adjust.settings.style <-
function(what.style) {
style <- tolower(what.style)
if (style == "all") {
.format.table.parts <<- c("=!","dependent variable label","dependent variables","models","columns","numbers","objects","-","coefficients","-","omit","-","additional","N","R-squared","adjusted R-squared","max R-squared","log likelihood","sigma2","theta(se)*(p)", "SER(df)","F statistic(df)*(p)","chi2(df)*(p)","Wald(df)*(p)","LR(df)*(p)","logrank(df)*(p)","AIC","BIC","UBRE","rho(se)*(p)","Mills(se)*(p)","residual deviance(df)*","null deviance(df)*","=!","notes")
.format.coefficient.table.parts <<- c("variable name","coefficient*","standard error","t-stat","p-value")
}
else if (style == "all2") {
.format.table.parts <<- c("=!","dependent variable label","dependent variables","models","columns","numbers","objects","-","coefficients","-","omit","-","additional","N","R-squared","adjusted R-squared","max R-squared","log likelihood","sigma2","theta(se)*(p)", "SER(df)","F statistic(df)*(p)","chi2(df)*(p)","Wald(df)*(p)","LR(df)*(p)","logrank(df)*(p)","AIC","BIC","UBRE","rho(se)*(p)","Mills(se)*(p)","residual deviance(df)*","null deviance(df)*","=!","notes")
.format.coefficient.table.parts <<- c("variable name","coefficient*","standard error")
}
# aer = American Economic Review
else if (style == "aer") {
.format.table.parts <<- c("=!","dependent variable label","dependent variables","models","columns","numbers","objects","-","coefficients","omit","additional","N","R-squared","adjusted R-squared","max R-squared","log likelihood","theta(se)*", "AIC","BIC","UBRE","rho(se)*","Mills(se)*", "SER(df)","F statistic(df)*","chi2(df)*","Wald(df)*","LR(df)*","logrank(df)*","-!","notes")
.format.models.skip.if.one <<- TRUE
.format.dependent.variable.text.on <<- FALSE
.format.until.nonzero.digit <<- FALSE
.format.max.extra.digits <<- 0
.format.model.left <<- ""
.format.model.right <<- ""
.format.note <<- "\\textit{Notes:}"
.format.note.alignment <<- "l"
.format.note.content <<- c("$^{***}$Significant at the [***] percent level.","$^{**}$Significant at the [**] percent level.","$^{*}$Significant at the [*] percent level.")
}
# ajps = American Journal of Political Science
else if (style == "ajps") {
.format.table.parts <<- c("-!","dependent variable label","dependent variables","models","columns","numbers","objects","-","coefficients","omit","additional","N","R-squared","adjusted R-squared","max R-squared","log likelihood","theta(se)*", "SER(df)","F statistic(df)*","chi2(df)*","Wald(df)*","LR(df)*","logrank(df)*","AIC","BIC","UBRE","rho(se)*","Mills(se)*","-!","notes")
.format.models.skip.if.one <<- TRUE
.format.dependent.variable.text.on <<- FALSE
.format.digit.separator <<- ""
.format.dependent.variables.left <<- "\\textbf{"
.format.dependent.variables.right <<- "}"
.format.column.left <<- "\\textbf{"
.format.column.right <<- "}"
.format.models.left <<- "\\textbf{"
.format.models.right <<- "}"
.format.numbers.left <<- "\\textbf{Model "
.format.numbers.right <<- "}"
.format.coefficient.table.parts <<- c("variable name","coefficient*","standard error")
.format.N <<- "N"
.format.AIC <<- "AIC"
.format.BIC <<- "BIC"
.format.chi.stat <<- "Chi-square"
.format.R2 <<- "R-squared"
.format.adj.R2 <<- "Adj. R-squared"
.format.max.R2 <<- "Max. R-squared"
.format.note <<- ""
.format.note.content <<- c("$^{***}$p $<$ [.***]; $^{**}$p $<$ [.**]; $^{*}$p $<$ [.*]")
.format.note.alignment <<- "l"
.format.s.stat.parts <<- c("-!","stat names","-","statistics1","-!","notes")
}
# ajs = American Journal of Sociology
else if (style == "ajs") {
.format.table.parts <<- c(" ","=!","dependent variable label","dependent variables","models","columns","numbers","objects","-","coefficients","omit","additional","N","R-squared","adjusted R-squared","max R-squared","log likelihood","theta(se)*", "AIC","BIC","UBRE","rho(se)*","Mills(se)*", "SER(df)","F statistic(df)*","chi2(df)*","Wald(df)*","LR(df)*","logrank(df)*","-!","notes")
.format.models.skip.if.one <<- TRUE
.format.dependent.variables.capitalize <<- TRUE
.format.dependent.variable.text.on <<- FALSE
.format.numbers.left <<- ""
.format.numbers.right <<- ""
.format.until.nonzero.digit <<- FALSE
.format.max.extra.digits <<- 0
.format.model.left <<- ""
.format.model.right <<- ""
.format.note <<- "\\textit{Notes:}"
.format.note.alignment <<- "l"
.format.note.content <<- c("$^{*}$P $<$ [.*]","$^{**}$P $<$ [.**]","$^{***}$P $<$ [.***]")
.format.cutoffs <<- c(0.05, 0.01, 0.001)
.format.initial.zero <<- FALSE
}
# apsr = American Political Science Review
else if (style == "apsr") {
.format.table.parts <<- c("-!","dependent variable label","dependent variables","models","columns","numbers","objects","-","coefficients","omit","additional","N","R-squared","adjusted R-squared","max R-squared","log likelihood","theta(se)*", "SER(df)","F statistic(df)*","chi2(df)*","Wald(df)*","LR(df)*","logrank(df)*","AIC","BIC","UBRE","rho(se)*","Mills(se)*","-!","notes")
.format.models.skip.if.one <<- TRUE
.format.dependent.variable.text.on <<- FALSE
.format.models.left <<- ""
.format.models.right <<- ""
.format.coefficient.table.parts <<- c("variable name","coefficient*","standard error")
.format.N <<- "N"
.format.AIC <<- "AIC"
.format.BIC <<- "BIC"
.format.chi.stat <<- "chi$^{2}$"
.format.note <<- ""
.format.note.content <<- c("$^{*}$p $<$ [.*]; $^{**}$p $<$ [.**]; $^{***}$p $<$ [.***]")
.format.note.alignment <<- "l"
.format.s.stat.parts <<- c("-!","stat names","-","statistics1","-!","notes")
}
# asq = Administrative Science Quarterly
else if (style == "asq") {
.format.table.parts <<- c("-!","dependent variable label","dependent variables","models","columns","numbers","objects","-","coefficients","omit","additional","N","R-squared","adjusted R-squared","max R-squared","log likelihood","theta(se)*", "SER(df)","F statistic(df)*","chi2(df)*","Wald(df)*","LR(df)*","logrank(df)*","AIC","BIC","UBRE","rho(se)*","Mills(se)*","-!","notes")
.format.models.skip.if.one <<- TRUE
.format.dependent.variable.text.on <<- FALSE
.format.digit.separator <<- ""
.format.dependent.variables.left <<- "\\textbf{"
.format.dependent.variables.right <<- "}"
.format.column.left <<- "\\textbf{"
.format.column.right <<- "}"
.format.models.left <<- "\\textbf{"
.format.models.right <<- "}"
.format.numbers.left <<- "\\textbf{Model "
.format.numbers.right <<- "}"
.format.coefficient.table.parts <<- c("variable name","coefficient*","standard error")
.format.AIC <<- "AIC"
.format.BIC <<- "BIC"
.format.chi.stat <<- "Chi-square"
.format.R2 <<- "R-squared"
.format.adj.R2 <<- "Adj. R-squared"
.format.max.R2 <<- "Max. R-squared"
.format.note <<- ""
.format.note.content <<- c("$^{\\bullet}$p $<$ [.*]; $^{\\bullet\\bullet}$p $<$ [.**]; $^{\\bullet\\bullet\\bullet}$p $<$ [.***]")
.format.note.alignment <<- "l"
.format.s.stat.parts <<- c("-!","stat names","-","statistics1","-!","notes")
.format.stars <<- "\\bullet"
}
# asr = American Sociological Review
else if (style == "asr") {
.format.table.parts <<- c("-!","dependent variable label","dependent variables","models","columns","numbers","objects","-","coefficients","omit","additional","N","R-squared","adjusted R-squared","max R-squared","log likelihood","theta(se)", "SER(df)","F statistic(df)*","chi2(df)*","Wald(df)*","LR(df)*","logrank(df)*","AIC","BIC","UBRE","rho(se)*","Mills(se)*","-!","notes")
.format.models.skip.if.one <<- TRUE
.format.dependent.variable.text.on <<- FALSE
.format.models.left <<- ""
.format.models.right <<- ""
.format.coefficient.table.parts <<- c("variable name","coefficient*")
.format.N <<- "\\textit{N}"
.format.AIC <<- "AIC"
.format.BIC <<- "BIC"
.format.chi.stat <<- "chi$^{2}$"
.format.note <<- ""
.format.note.content <<- c("$^{*}$p $<$ [.*]; $^{**}$p $<$ [.**]; $^{***}$p $<$ [.***]")
.format.cutoffs <<- c(0.05, 0.01, 0.001)
.format.note.alignment <<- "l"
.format.s.stat.parts <<- c("-!","stat names","-","statistics1","-!","notes")
}
# "demography" = Demography
else if (style == "demography") {
.format.table.parts <<- c("-!","dependent variable label","dependent variables","models","columns","numbers","objects","-","coefficients","omit","additional","N","R-squared","adjusted R-squared","max R-squared","log likelihood","theta(se)*", "SER(df)","F statistic(df)*","chi2(df)*","Wald(df)*","LR(df)*","logrank(df)*","AIC","BIC","UBRE","rho(se)*","Mills(se)*","-!","notes")
.format.models.skip.if.one <<- TRUE
.format.dependent.variable.text.on <<- FALSE
.format.models.left <<- ""
.format.models.right <<- ""
.format.numbers.left <<- "Model "
.format.numbers.right <<- ""
.format.coefficient.table.parts <<- c("variable name","coefficient*","standard error")
.format.N <<- "\\textit{N}"
.format.AIC <<- "AIC"
.format.BIC <<- "BIC"
.format.chi.stat <<- "Chi-Square"
.format.note <<- ""
.format.note.content <<- c("$^{*}$p $<$ [.*]; $^{**}$p $<$ [.**]; $^{***}$p $<$ [.***]")
.format.cutoffs <<- c(0.05, 0.01, 0.001)
.format.note.alignment <<- "l"
.format.s.stat.parts <<- c("-!","stat names","-","statistics1","-!","notes")
}
# io = International Organization
else if (style == "io") {
.format.table.parts <<- c("-!","dependent variable label","dependent variables","models","columns","numbers","objects","-","coefficients","omit","additional","N","R-squared","adjusted R-squared","max R-squared","log likelihood","theta(se)*", "SER(df)","F statistic(df)*","chi2(df)*","Wald(df)*","LR(df)*","logrank(df)*","AIC","BIC","UBRE","rho(se)*","Mills(se)*","-!","notes")
.format.models.skip.if.one <<- TRUE
.format.dependent.variable.text.on <<- FALSE
.format.coefficient.table.parts <<- c("variable name","coefficient*","standard error")
.format.coefficient.variables.capitalize <<- TRUE
.format.s.coefficient.variables.capitalize <<- TRUE
.format.intercept.name <<- "Constant"
.format.N <<- "\\textit{Observations}"
.format.AIC <<- "\\textit{Akaike information criterion}"
.format.BIC <<- "\\textit{Bayesian information criterion}"
.format.chi.stat <<- "\\textit{Chi-square}"
.format.logrank.stat <<- "\\textit{Score (logrank) test}"
.format.lr.stat <<- "\\textit{LR test}"
.format.max.R2 <<- "\\textit{Maximum R-squared}"
.format.R2 <<- "\\textit{R-squared}"
.format.adj.R2 <<- "\\textit{Adjusted R-squared}"
.format.UBRE <<- "\\textit{UBRE}"
.format.F.stat <<- "\\textit{F statistic}"
.format.LL <<- "\\textit{Log likelihood}"
.format.SER <<- "\\textit{Residual standard error}"
.format.null.deviance <<- "\\textit{Null deviance}"
.format.residual.deviance <<- "\\textit{Residual deviance}"
.format.scale <<- "\\textit{Scale}"
.format.wald.stat <<- "\\textit{Wald test}"
.format.note <<- "\\textit{Notes:}"
.format.note.content <<- c("$^{***}$p $<$ [.***]; $^{**}$p $<$ [.**]; $^{*}$p $<$ [.*]")
.format.note.alignment <<- "l"
.format.s.stat.parts <<- c("-!","stat names","-","statistics1","-!","notes")
}
# jpam = Journal of Policy Analysis and Management
else if (style == "jpam") {
.format.table.parts <<- c("-!","dependent variable label","dependent variables","models","columns","numbers","objects","-","coefficients","omit","additional","N","R-squared","adjusted R-squared","max R-squared","log likelihood","theta(se)*", "SER(df)","F statistic(df)*","chi2(df)*","Wald(df)*","LR(df)*","logrank(df)*","AIC","BIC","UBRE","rho(se)*","Mills(se)*","-!","notes")
.format.models.skip.if.one <<- TRUE
.format.dependent.variable.text.on <<- FALSE
.format.models.left <<- ""
.format.models.right <<- ""
.format.numbers.left <<- "Model "
.format.numbers.right <<- ""
.format.numbers.roman <<- TRUE
.format.coefficient.table.parts <<- c("variable name","coefficient*","standard error")
.format.intercept.bottom <<- FALSE
.format.intercept.top <<- TRUE
.format.N <<- "N"
.format.AIC <<- "AIC"
.format.BIC <<- "BIC"
.format.note <<- "\\textit{Note:}"
.format.note.content <<- c("$^{***}$p $<$ [.***]; $^{**}$p $<$ [.**]; $^{*}$p $<$ [.*]")
.format.note.alignment <<- "l"
.format.s.stat.parts <<- c("-!","stat names","-","statistics1","-!","notes")
.format.s.statistics.names <<- cbind(c("n","N"), c("nmiss","missing"), c("mean","Mean"), c("sd","SD"), c("median","Median"), c("min","Minimum"), c("max","Maximum"), c("mad","Median Abs. Dev."), c("p","Percentile(!)"))
}
# "qje" = Quarterly Journal of Economics
else if (style=="qje") {
.format.table.parts <<- c("=!","dependent variable label","dependent variables","models","columns","numbers","objects","-","coefficients","omit","additional","N","R-squared","adjusted R-squared","max R-squared","log likelihood","theta(se)*", "AIC","BIC","UBRE","rho(se)*","Mills(se)*", "SER(df)","F statistic(df)*","chi2(df)*","Wald(df)*","LR(df)*","logrank(df)*","=!","notes")
.format.dependent.variable.text.on <<- FALSE
.format.s.stat.parts <<- c("-!","stat names","=","statistics1","=!","notes")
.format.N <<- "\\textit{N}"
.format.note <<- "\\textit{Notes:}"
.format.note.content <<- c("$^{***}$Significant at the [***] percent level.", "$^{**}$Significant at the [**] percent level.", "$^{*}$Significant at the [*] percent level.")
}
# find style based on journal ("default" or other)
else if (style=="commadefault") {
.format.table.parts <<- c("=!","dependent variable label","dependent variables","models","columns","numbers","objects","-","coefficients","-","omit","-","additional","N","R-squared","adjusted R-squared","max R-squared","log likelihood","sigma2","theta(se)*", "AIC","BIC","UBRE","rho(se)*","Mills(se)*", "SER(df)","F statistic(df)*","chi2(df)*","Wald(df)*","LR(df)*","logrank(df)*","=!","notes")
.format.digit.separator <<- " "
.format.decimal.character <<- ","
}
else if (style=="default") {
.format.table.parts <<- c("=!","dependent variable label","dependent variables","models","columns","numbers","objects","-","coefficients","-","omit","-","additional","N","R-squared","adjusted R-squared","max R-squared","log likelihood","sigma2","theta(se)*", "AIC","BIC","UBRE","rho(se)*","Mills(se)*", "SER(df)","F statistic(df)*","chi2(df)*","Wald(df)*","LR(df)*","logrank(df)*","=!","notes")
}
}
.apply <-
function(auto.t, auto.p)
{
if ((!is.null(apply.coef)) || ((!is.null(apply.se)))) {
if (!is.null(apply.coef)) { .global.coefficients <<- apply(.global.coefficients, c(1,2), apply.coef) }
if (!is.null(apply.se)) { .global.std.errors <<- apply(.global.std.errors, c(1,2), apply.se) }
if (auto.t == TRUE) { .global.t.stats <<- .global.coefficients / .global.std.errors }
if (auto.p == TRUE) { .global.p.values <<- 2 * pnorm( abs( .global.t.stats ) , mean = 0, sd = 1, lower.tail = FALSE, log.p = FALSE) }
}
if (!is.null(apply.t)) { .global.t.stats <<- apply(.global.t.stats, c(1,2), apply.t) }
if (!is.null(apply.p)) { .global.p.values <<- apply(.global.p.values, c(1,2), apply.p) }
}
.AIC <-
function(object.name) {
model.name <- .get.model.name(object.name)
if (model.name %in% c("coeftest")) {
return(NA)
}
if (model.name %in% c("lmer","lme","nlme","glmer","nlmer", "ergm", "gls", "Gls", "lagsarlm", "errorsarlm", "", "Arima")) {
return(as.vector(AIC(object.name)))
}
if (model.name %in% c("censReg")) {
return(as.vector(AIC(object.name)[1]))
}
if (model.name %in% c("fGARCH")) {
return(object.name@fit$ics["AIC"])
}
if (model.name %in% c("maBina")) {
return(as.vector(object.name$w$aic))
}
if (model.name %in% c("arima")) {
return(as.vector(object.name$aic))
}
else if (!is.null(.summary.object$aic)) {
return(as.vector(.summary.object$aic))
}
else if (!is.null(object.name$AIC)) {
return(as.vector(object.name$AIC))
}
return(NA)
}
.BIC <-
function(object.name) {
model.name <- .get.model.name(object.name)
if (model.name %in% c("coeftest","maBina","Arima")) {
return(NA)
}
if (model.name %in% c("censReg")) {
return(as.vector(BIC(object.name)[1]))
}
if (model.name %in% c("fGARCH")) {
return(object.name@fit$ics["BIC"])
}
if (model.name %in% c("lmer","lme","nlme","glmer","nlmer", "ergm", "gls", "Gls")) {
return(as.vector(BIC(object.name)))
}
if (model.name %in% c("arima")) {
return(as.vector(object.name$bic))
}
else if (!is.null(.summary.object$bic)) {
return(as.vector(.summary.object$bic))
}
else if (!is.null(object.name$BIC)) {
return(as.vector(object.name$BIC))
}
return(NA)
}
.chi.stat <-
function(object.name) {
chi.output <- as.vector(rep(NA,times=3))
model.name <- .get.model.name(object.name)
if (!(model.name %in% c("arima","fGARCH","Arima","maBina","coeftest","lmer", "Gls", "glmer", "nlmer", "normal.gam","logit.gam","probit.gam","poisson.gam","gam()"))) {
if (!is.null(.summary.object$chi)) {
chi.value <- suppressMessages(.summary.object$chi)
df.value <- suppressMessages(.summary.object$df) - suppressMessages(.summary.object$idf)
chi.p.value <- pchisq(chi.value, df.value, ncp=0, lower.tail = FALSE, log.p = FALSE)
chi.output <- as.vector(c(chi.value, df.value, chi.p.value))
}
else if (model.name %in% c("cph", "lrm", "ols", "psm")) {
chi.value <- object.name$stat["Model L.R."]
df.value <- object.name$stat["d.f."]
chi.p.value <- pchisq(chi.value, df.value, ncp=0, lower.tail = FALSE, log.p = FALSE)
chi.output <- as.vector(c(chi.value, df.value, chi.p.value))
}
else if (model.name %in% c("probit.ss")) {
chi.value <- object.name$LRT$LRT
df.value <- object.name$LRT$df
chi.p.value <- pchisq(chi.value, df.value, ncp=0, lower.tail = FALSE, log.p = FALSE)
chi.output <- as.vector(c(chi.value, df.value, chi.p.value))
}
}
names(chi.output) <- c("statistic","df1","p-value")
return(cbind(chi.output))
}
.coefficient.table.part <-
function(part, which.variable, variable.name=NULL) {
# coefficient variable name
if (part=="variable name") {
# use intercept name for intercept, otherwise variable name
if (is.na(.format.covariate.labels[.which.variable.label])) {
if (.format.coefficient.variables.capitalize == TRUE) { cat(" ", .format.coefficient.variables.left, toupper(variable.name), .format.coefficient.variables.right, sep="") }
else { cat(" ", .format.coefficient.variables.left, variable.name, .format.coefficient.variables.right, sep="") }
}
else { cat(" ", .format.coefficient.variables.left, .format.covariate.labels[.which.variable.label], .format.coefficient.variables.right, sep="") }
}
# coefficients and stars
else if ((part=="coefficient") || (part=="coefficient*")) {
for (i in seq(1:length(.global.models))) {
if (!is.na(.global.coefficients[.global.coefficient.variables[which.variable],i])) {
# report the coefficient
cat(" & ", .iround(.global.coefficients[.global.coefficient.variables[which.variable],i],.format.round.digits),sep="")
# add stars to denote statistical significance
if (part=="coefficient*") {
p.value <- .global.p.values[.global.coefficient.variables[which.variable],i]
.enter.significance.stars(p.value)
}
}
else {
cat(" & ",sep="")
}
# if single-row, follow up with standard error / confidence interval
if ((.format.single.row == TRUE) && (("standard error" %in% .format.coefficient.table.parts) || ("standard error*" %in% .format.coefficient.table.parts))) {
if (.format.dec.mark.align == TRUE) { space.char <- "$ $"}
else { space.char <- " "}
if (!is.na(.global.std.errors[.global.coefficient.variables[which.variable],i])) {
# report standard errors or confidence intervals
.format.ci.use <- .format.ci[i]
if (is.na(.format.ci.use)) {
for (j in i:1) {
if (!is.na(.format.ci[j])) {
.format.ci.use <- .format.ci[j]
break
}
}
}
if (.format.ci.use == TRUE) {
# if ci level is NA, find the most recent set level
.format.ci.level.use <- .format.ci.level[i]
if (is.na(.format.ci.level.use)) {
for (j in i:1) {
if (!is.na(.format.ci.level[j])) {
.format.ci.level.use <- .format.ci.level[j]
break
}
}
}
z.value <- qnorm((1 + .format.ci.level.use)/2)
coef <- .global.coefficients[.global.coefficient.variables[which.variable],i]
se <- .global.std.errors[.global.coefficient.variables[which.variable],i]
ci.lower.bound <- coef - z.value * se
ci.upper.bound <- coef + z.value * se
if (!is.null(ci.custom[[i]])) {
ci.lower.bound.temp <- .global.ci.lb[.global.coefficient.variables[which.variable],i]
ci.upper.bound.temp <- .global.ci.rb[.global.coefficient.variables[which.variable],i]
if (!is.na(ci.lower.bound.temp)) (ci.lower.bound <- ci.lower.bound.temp)
if (!is.na(ci.upper.bound.temp)) (ci.upper.bound <- ci.upper.bound.temp)
}
if (!is.null(apply.ci)) {
ci.lower.bound <- do.call(apply.ci, list(ci.lower.bound))
ci.upper.bound <- do.call(apply.ci, list(ci.upper.bound))
}
if (.format.dec.mark.align == TRUE) {
hyphen <- paste("$",.format.ci.separator,"$", sep="")
}
else {
hyphen <- .format.ci.separator
}
cat(space.char, .format.std.errors.left, .iround(ci.lower.bound,.format.round.digits),hyphen,.iround(ci.upper.bound,.format.round.digits),.format.std.errors.right,sep="")
}
else {
cat(space.char, .format.std.errors.left, .iround(.global.std.errors[.global.coefficient.variables[which.variable],i],.format.round.digits),.format.std.errors.right,sep="")
}
# add stars to denote statistical significance
if ("standard error*" %in% .format.coefficient.table.parts) {
p.value <- .global.p.values[.global.coefficient.variables[which.variable],i]
.enter.significance.stars(p.value)
}
}
}
}
cat(" \\\\ \n ")
}
# standard errors
else if (((part=="standard error") || (part=="standard error*")) && (.format.single.row==FALSE)) {
for (i in seq(1:length(.global.models))) {
if (!is.na(.global.std.errors[.global.coefficient.variables[which.variable],i])) {
# report standard errors or confidence intervals
.format.ci.use <- .format.ci[i]
if (is.na(.format.ci.use)) {
for (j in i:1) {
if (!is.na(.format.ci[j])) {
.format.ci.use <- .format.ci[j]
break
}
}
}
if (.format.ci.use == TRUE) {
# if ci level is NA, find the most recent set level
.format.ci.level.use <- .format.ci.level[i]
if (is.na(.format.ci.level.use)) {
for (j in i:1) {
if (!is.na(.format.ci.level[j])) {
.format.ci.level.use <- .format.ci.level[j]
break
}
}
}
z.value <- qnorm((1 + .format.ci.level.use)/2)
coef <- .global.coefficients[.global.coefficient.variables[which.variable],i]
se <- .global.std.errors[.global.coefficient.variables[which.variable],i]
ci.lower.bound <- coef - z.value * se
ci.upper.bound <- coef + z.value * se
if (!is.null(ci.custom[[i]])) {
ci.lower.bound.temp <- .global.ci.lb[.global.coefficient.variables[which.variable],i]
ci.upper.bound.temp <- .global.ci.rb[.global.coefficient.variables[which.variable],i]
if (!is.na(ci.lower.bound.temp)) (ci.lower.bound <- ci.lower.bound.temp)
if (!is.na(ci.upper.bound.temp)) (ci.upper.bound <- ci.upper.bound.temp)
}
if (!is.null(apply.ci)) {
ci.lower.bound <- do.call(apply.ci, list(ci.lower.bound))
ci.upper.bound <- do.call(apply.ci, list(ci.upper.bound))
}
if (.format.dec.mark.align == TRUE) {
hyphen <- paste("$",.format.ci.separator,"$", sep="")
}
else {
hyphen <- .format.ci.separator
}
if (.format.dec.mark.align == TRUE) {
cat(" & \\multicolumn{1}{c}{", .format.std.errors.left, .iround(ci.lower.bound,.format.round.digits),hyphen,.iround(ci.upper.bound,.format.round.digits),.format.std.errors.right,"}",sep="")
}
else {
cat(" & ", .format.std.errors.left, .iround(ci.lower.bound,.format.round.digits),hyphen,.iround(ci.upper.bound,.format.round.digits),.format.std.errors.right,sep="")
}
}
else {
cat(" & ", .format.std.errors.left, .iround(.global.std.errors[.global.coefficient.variables[which.variable],i],.format.round.digits),.format.std.errors.right,sep="")
}
# add stars to denote statistical significance
if (part=="standard error*") {
p.value <- .global.p.values[.global.coefficient.variables[which.variable],i]
.enter.significance.stars(p.value)
}
}
else {
cat(" & ",sep="")
}
}
cat(" \\\\ \n ")
}
# p-values
else if ((part=="p-value") || (part=="p-value*")) {
for (i in seq(1:length(.global.models))) {
if (!is.na(.global.p.values[.global.coefficient.variables[which.variable],i])) {
# report p-values
cat(" & ", .format.p.values.left, .iround(.global.p.values[.global.coefficient.variables[which.variable],i],.format.round.digits,round.up.positive=TRUE),.format.p.values.right,sep="")
# add stars to denote statistical significance
if (part=="p-value*") {
p.value <- .global.p.values[.global.coefficient.variables[which.variable],i]
.enter.significance.stars(p.value)
}
}
else {
cat(" & ",sep="")
}
}
cat(" \\\\ \n ")
}
# t-statistics
else if ((part=="t-stat") || (part=="t-stat*")) {
for (i in seq(1:length(.global.models))) {
if (!is.na(.global.t.stats[.global.coefficient.variables[which.variable],i])) {
# report t-statistics
cat(" & ", .format.t.stats.left, .iround(.global.t.stats[.global.coefficient.variables[which.variable],i],.format.round.digits),.format.t.stats.right,sep="")
# add stars to denote statistical significance
if (part=="t-stat*") {
p.value <- .global.p.values[.global.coefficient.variables[which.variable],i]
.enter.significance.stars(p.value)
}
}
else {
cat(" & ",sep="")
}
}
cat(" \\\\ \n ")
}
# empty line
else if (part==" ") {
.table.empty.line()
}
# horizontal line
else if (part=="-") {
cat("\\hline ")
.table.insert.space()
cat(" \n")
}
# double horizontal line
else if (part=="=") {
cat("\\hline \n")
cat("\\hline ")
.table.insert.space()
cat(" \n")
}
}
.coefficient.variables <-
function(object.name) {
model.name <- .get.model.name(object.name)
if (model.name %in% c("ls", "normal", "logit", "probit", "relogit", "poisson", "negbin", "normal.gee", "logit.gee", "probit.gee", "poisson.gee", "normal.gam",
"logit.gam", "probit.gam", "poisson.gam", "normal.survey", "poisson.survey", "probit.survey", "logit.survey", "gamma", "gamma.gee", "gamma.survey",
"exp", "weibull", "coxph", "clogit", "lognorm", "tobit", "tobit(AER)", "brglm", "glm()", "Glm()", "svyglm()", "gee()", "survreg()", "gam()", "plm", "ivreg", "pmg", "lmrob", "glmrob",
"dynlm", "gls", "rq", "lagsarlm", "errorsarlm", "gmm", "mclogit")) {
return(as.vector(names(object.name$coefficients)))
}
else if (model.name %in% c("Arima")) {
return(names(object.name$coef))
}
else if (model.name %in% c("fGARCH")) {
return(rownames(object.name@fit$matcoef))
}
else if (model.name %in% c("censReg")) {
return(rownames(.summary.object$estimate))
}
else if (model.name %in% c("mnlogit")) {
return(rownames(.summary.object$CoefTable))
}
else if (model.name %in% c("lme","nlme")) {
return(rownames(.summary.object$tTable))
}
else if (model.name %in% c("felm")) {
return(row.names(object.name$coefficients))
}
else if (model.name %in% c("maBina")) {
return(as.vector(rownames(object.name$out)))
}
else if (model.name %in% c("mlogit")) {
return(as.vector(rownames(.summary.object$CoefTable)))
}
else if (model.name %in% c("hetglm")) {
return(as.vector(names(object.name$coefficients$mean)))
}
else if (model.name %in% c("selection","heckit")) {
if (!.global.sel.equation) {
indices <- .summary.object$param$index$betaO ### outcome equation
}
else {
indices <- .summary.object$param$index$betaS ### selection equation
}
return(as.vector(names(.summary.object$estimate[indices, 1])))
}
else if (model.name %in% c("probit.ss", "binaryChoice")) {
return(as.vector(names(.summary.object$estimate[,1])))
}
else if (model.name %in% c("coeftest")) {
return(as.vector(rownames(object.name)))
}
else if (model.name %in% c("clm")) {
if (.format.ordered.intercepts == FALSE) { return(as.vector(names(object.name$beta))) }
else { return(c(as.vector(names(object.name$beta)), as.vector(names(object.name$alpha)))) }
}
else if (model.name %in% c("lmer", "glmer", "nlmer", "pgmm")) {
return(as.vector(rownames(.summary.object$coefficients)))
}
else if (model.name %in% c("ergm", "rem.dyad")) {
return(as.vector(names(object.name$coef)))
}
else if (model.name %in% c("betareg")) {
return(as.vector(names(object.name$coefficients$mean)))
}
else if (model.name %in% c("zeroinfl", "hurdle")) {
if (.global.zero.component==FALSE) {
return(as.vector(names(object.name$coefficients$count)))
}
else {
return(as.vector(names(object.name$coefficients$zero)))
}
}
else if (model.name %in% c("cloglog.net", "gamma.net", "logit.net", "probit.net")) {
return(as.vector(rownames(.summary.object$coefficients)))
}
else if (model.name %in% c("rlm")) {
return(as.vector(rownames(suppressMessages(.summary.object$coefficients))))
}
else if (model.name %in% c("ologit", "oprobit", "polr()")) {
coef.temp <- as.vector(rownames(suppressMessages(.summary.object$coefficients)))
if (.format.ordered.intercepts == FALSE) { return(coef.temp[seq(from=1, to=length(coef.temp)-(length(suppressMessages(.summary.object$lev))-1))]) }
else { return(coef.temp) }
}
else if (model.name %in% c("arima")) {
return(as.vector(names(object.name$coef)))
}
else if (model.name %in% c("multinom")) {
return(as.vector(object.name$coefnames))
}
else if (model.name %in% c("weibreg", "coxreg", "phreg", "aftreg", "bj", "cph", "Gls", "lrm", "ols", "psm", "Rq")) {
return(as.vector(names(object.name$coefficients)))
}
return(NULL)
}
.dependent.variable <-
function(object.name, model.num=1) {
model.name <- .get.model.name(object.name)
if (model.name %in% c("lmer", "glmer", "nlmer", "gls")) {
return(as.vector(as.character(formula(object.name))[2]))
}
if (model.name %in% c("Arima")) {
return(as.character(object.name$call$x))
}
if (model.name %in% c("fGARCH")) {
return(as.character(object.name@call$data))
}
if (model.name %in% c("multinom")) {
if (!is.null(rownames(.summary.object$coefficients))) {
return(as.vector(rownames(.summary.object$coefficients)[model.num]))
}
}
if (model.name %in% c("rem.dyad", "coeftest")) {
return(as.vector(as.character(" ")))
}
if (model.name %in% c("gmm")) {
formula <- object.name$call[2]
position <- regexpr("~", formula, fixed=T)
return( .trim(substr(formula, 1, position-1)) )
}
if (model.name %in% c("selection","heckit")) {
if (!.global.sel.equation) {
formula <- object.name$call["outcome"] ### outcome
}
else {
formula <- object.name$call["selection"] ### outcome
}
position <- regexpr("~", formula, fixed=T)
return( .trim(substr(formula, 1, position-1)))
}
if (model.name %in% c("probit.ss","binaryChoice")) {
formula <- object.name$call["formula"]
position <- regexpr("~", formula, fixed=T)
return( .trim(substr(formula, 1, position-1)))
}
if (model.name %in% c("maBina")) {
object.name <- object.name$w
}
if (model.name %in% c("lme")) {
object.name$call$formula <- object.name$call$fixed
}
if (model.name %in% c("nlme")) {
object.name$call$formula <- object.name$call$model
}
if (!is.null(object.name$call$formula)) {
if (is.symbol(object.name$call$formula)) {
formula.temp <- as.formula(object.name)
}
else {
formula.temp <- object.name$call$formula
}
if (length(as.vector(as.character(formula.temp)))>1) {
return(as.vector(as.character(formula.temp)[2]))
}
}
if (!is.null(object.name$formula)) {
if (is.symbol(object.name$formula)) {
formula.temp <- as.formula(object.name)
}
else {
formula.temp <- object.name$formula
}
if (length(as.vector(as.character(formula.temp)))>1) { # this is for zelig$result ones
return(as.vector(as.character(formula.temp)[2]))
}
}
if (!is.null(object.name$formula2)) {
if (is.symbol(object.name$formula2)) {
formula.temp <- as.formula(object.name)
}
else {
formula.temp <- object.name$formula2
}
if (length(as.vector(as.character(formula.temp)))>1) { # z.ls
return(as.vector(as.character(formula.temp)[2]))
}
}
return("")
}
.dependent.variable.written <-
function(object.name, model.num=1) {
model.name <- .get.model.name(object.name)
if (model.name %in% c("tobit","ologit","oprobit", "relogit", "coxph","exp","lognorm","weibull","survreg()","arima",
"aftreg", "weibreg", "coxreg", "phreg", "bj", "cph", "psm")) {
written.var <- .inside.bracket(.dependent.variable(object.name))[1]
}
else if (model.name %in% c("clogit","mclogit")) {
written.var <- .inside.bracket(.dependent.variable(object.name))[2]
}
else { written.var <- .dependent.variable(object.name, model.num) }
# some formatting changes
# remove everything before and including he last dollar sign from variable name
temp <- strsplit(written.var,"$",fixed=TRUE)
written.var <- temp[[1]][length(temp[[1]])]
# if underscore or ^, etc. in variable name, then insert an escape \ before it
written.var <- .remove.special.chars(written.var)
return(written.var)
}
.enter.significance.stars <-
function(p.value, force.math=FALSE) {
if ((!is.na(p.value)) && (!is.null(p.value))) {
if (.format.dec.mark.align == TRUE) {
c <- ""
}
else {
c <- "$"
}
if (force.math == TRUE) { c <- "$" }
cutoffs <- .format.cutoffs[length(.format.cutoffs):1]
stars <- .format.stars[length(.format.stars):1]
for (i in 1:length(cutoffs)) {
if (!is.na(cutoffs[i])) {
if (p.value < cutoffs[i]) {
cat(c,"^{",stars[i],"}",c,sep="")
break
}
}
}
}
}
.F.stat <-
function(object.name) {
F.stat.output <- as.vector(rep(NA,times=4))
model.name <- .get.model.name(object.name)
if (!(model.name %in% c("arima","fGARCH", "Arima", "maBina","coeftest", "lmer", "glmer", "nlmer", "Gls"))) {
if (model.name %in% c("plm")) {
F.stat.value <- .summary.object$fstatistic$statistic
df.numerator <- .summary.object$fstatistic$parameter["df1"]
df.denominator <- .summary.object$fstatistic$parameter["df2"]
F.stat.p.value <- .summary.object$fstatistic$p.value
F.stat.output <- as.vector(c(F.stat.value, df.numerator, df.denominator, F.stat.p.value))
}
else if (!is.null(suppressMessages(.summary.object$fstatistic["value"]))) {
F.stat.value <- .summary.object$fstatistic["value"]
df.numerator <- .summary.object$fstatistic["numdf"]
df.denominator <- .summary.object$fstatistic["dendf"]
F.stat.p.value <- pf(F.stat.value, df.numerator, df.denominator, lower.tail=FALSE)
F.stat.output <- as.vector(c(F.stat.value, df.numerator, df.denominator, F.stat.p.value))
}
}
names(F.stat.output) <- c("statistic","df1","df2","p-value")
return(cbind(F.stat.output))
}
.gcv.UBRE <-
function(object.name) {
model.name <- .get.model.name(object.name)
if (!(model.name %in% c("arima","fGARCH", "Arima", "maBina", "coeftest", "lmer", "Gls", "glmer", "nlmer"))) {
if (!is.null(object.name$gcv.ubre)) {
return(as.vector(object.name$gcv.ubre))
}
}
return(NA)
}
# fill in NAs into a if b is the longer vector
.fill.NA <-
function(a, b) {
a.temp <- a; b.temp <- b
if (length(a) >= length(b)) {
return(a.temp)
}
else {
length(a.temp) <- length(b)
return(a.temp)
}
}
.get.model.name <-
function(object.name) {
return.value <- .model.identify(object.name)
if (substr(return.value,1,5)=="glm()") { return.value <- "glm()" }
if (substr(return.value,1,8)=="svyglm()") { return.value <- "svyglm()" }
if (substr(return.value,1,5)=="gee()") { return.value <- "gee()" }
if (substr(return.value,1,5)=="gam()") { return.value <- "gam()" }
if (substr(return.value,1,6)=="polr()") { return.value <- "polr()" }
if (substr(return.value,1,9)=="survreg()") { return.value <- "survreg()" }
return(return.value)
}
.get.p.values.1 <-
function(object.name, user.given=NULL, auto=TRUE, f.coef=NULL, f.se=NULL, user.coef=NULL, user.se=NULL, model.num=1) {
if (!is.null(user.given)) {
if (.model.identify(object.name) == "multinom") {
if (!is.null(nrow(user.given))) {
user.given <- as.vector(user.given[model.num,])
}
}
return(user.given)
}
if (auto == TRUE) {
if ((!is.null(user.coef)) || (!is.null(user.se))) {
#if (.model.identify(object.name) == "multinom") {
# f.coef <- as.vector(f.coef[model.num,])
# f.se <- as.vector(f.se[model.num,])
#}
# set the lengths of the vectors to be equal to each other
coef.div <- .fill.NA(f.coef, f.se)
se.div <- .fill.NA(f.se, f.coef)
t.out <- (coef.div / se.div)
auto.return <- 2*pnorm(abs(t.out), mean = 0, sd = 1, lower.tail = FALSE, log.p = FALSE)
names(auto.return) <- names(f.coef)
return( auto.return )
}
}
model.name <- .get.model.name(object.name)
if (model.name %in% c("ls", "normal", "logit", "probit", "relogit", "poisson", "negbin", "normal.survey", "poisson.survey", "probit.survey", "logit.survey", "gamma", "gamma.survey",
"cloglog.net", "gamma.net", "logit.net", "probit.net", "brglm", "glm()", "Glm()", "svyglm()", "plm", "pgmm", "ivreg", "lmrob", "glmrob", "dynlm", "rq", "gmm","mclogit","felm")) {
return(.summary.object$coefficients[,4])
}
if (model.name %in% c("censReg")) {
return(.summary.object$estimate[,4])
}
if (model.name %in% c("mnlogit")) {
return(.summary.object$CoefTable[,4])
}
if (model.name %in% c("fGARCH")) {
return(object.name@fit$matcoef[,4])
}
if (model.name %in% c("lme", "nlme")) {
return(.summary.object$tTable[,5])
}
if (model.name %in% c("maBina")) {
return(as.vector(object.name$out[,4]))
}
if (model.name %in% c("mlogit")) {
return(as.vector(.summary.object$CoefTable[,4]))
}
if (model.name %in% c("coeftest")) {
return(as.vector(object.name[,4]))
}
if (model.name %in% c("hetglm")) {
return(as.vector(.summary.object$coefficients$mean[,4]))
}
if (model.name %in% c("selection","heckit")) {
if (!.global.sel.equation) {
indices <- .summary.object$param$index$betaO ### outcome equation
}
else {
indices <- .summary.object$param$index$betaS ### selection equation
}
return(as.vector(.summary.object$estimate[indices,4]))
}
if (model.name %in% c("probit.ss", "binaryChoice")) {
return(as.vector(.summary.object$estimate[,4]))
}
if (model.name %in% c("lagsarlm", "errorsarlm")) {
return(.summary.object$Coef[,4])
}
if (model.name %in% c("lmer", "glmer", "nlmer")) {
Vcov <- as.matrix(vcov(object.name, useScale = FALSE))
coefs <- .summary.object$coefficients[,1]
se <- sqrt(diag(Vcov))
tstat <- coefs / se
pval <- 2 * pnorm(abs(tstat), lower.tail = FALSE)
names(pval) <- names(coefs)
return(pval)
}
if (model.name %in% c("Arima")) {
coef.temp <- object.name$coef
se.temp <- sqrt(diag(object.name$var.coef))
tstat <- coef.temp / se.temp
pval <- 2 * pnorm(abs(tstat), lower.tail = FALSE)
return(pval)
}
if (model.name %in% c("ergm")) {
return(.summary.object$coefs[,4])
}
if (model.name %in% c("clm")) {
if (.format.ordered.intercepts == FALSE) {
return(.summary.object$coefficients[(length(object.name$alpha)+1):(length(object.name$coefficients)),4])
}
else {
return(.summary.object$coefficients[,4])
}
}
else if (model.name %in% c("pmg")) {
coef.temp <- .summary.object$coefficients
std.err.temp <- sqrt(diag(.summary.object$vcov))
t.stat.temp <- coef.temp / std.err.temp
df.temp <- length(.summary.object$residuals)
return( 2 * pt(abs(t.stat.temp), df=df.temp, lower.tail = FALSE, log.p = FALSE) )
}
else if (model.name %in% c("zeroinfl", "hurdle")) {
if (.global.zero.component==FALSE) {
return(.summary.object$coefficients$count[,4])
}
else {
return(.summary.object$coefficients$zero[,4])
}
}
else if (model.name %in% c("normal.gee", "logit.gee", "poisson.gee", "probit.gee", "gamma.gee", "gee()")) {
return(2*pnorm(abs(.summary.object$coefficients[,"Robust z"]), mean = 0, sd = 1, lower.tail = FALSE, log.p = FALSE))
}
else if (model.name %in% c("normal.gam", "logit.gam", "probit.gam", "poisson.gam", "gam()")) {
return(.summary.object$p.pv)
}
else if (model.name %in% c("coxph", "clogit")) {
return(.summary.object$coef[,"Pr(>|z|)"])
}
else if (model.name %in% c("exp","lognorm","weibull","tobit", "survreg()")) {
return(.summary.object$table[,"p"])
}
else if (model.name %in% c("rlm")) {
coef.temp <- suppressMessages(.summary.object$coefficients[,"t value"])
coef.temp <- 2*pnorm(abs(coef.temp[seq(from=1, to=length(coef.temp))]), mean = 0, sd = 1, lower.tail = FALSE, log.p = FALSE)
return(coef.temp)
}
else if (model.name %in% c("ologit", "oprobit", "polr()")) {
coef.temp <- suppressMessages(.summary.object$coefficients[,"t value"])
if (.format.ordered.intercepts == FALSE) { return(2*pnorm(abs(coef.temp[seq(from=1, to=length(coef.temp)-(length(suppressMessages(.summary.object$lev))-1))]), mean = 0, sd = 1, lower.tail = FALSE, log.p = FALSE)) }
else {
return( 2*pnorm(abs(coef.temp[seq(from=1, to=length(coef.temp))]), mean = 0, sd = 1, lower.tail = FALSE, log.p = FALSE) )
}
}
else if (model.name %in% c("arima")) {
return(2*pnorm( abs(object.name$coef / (sqrt(diag(object.name$var.coef))) ), mean = 0, sd = 1, lower.tail = FALSE, log.p = FALSE))
}
else if (model.name %in% c("tobit(AER)")){
return(.summary.object$coefficients[,"Pr(>|z|)"])
}
else if (model.name %in% c("multinom")) {
if (is.null(nrow(.summary.object$coefficients))) {
coef.temp <- .summary.object$coefficients
se.temp <- .summary.object$standard.errors
}
else {
coef.temp <- .summary.object$coefficients[model.num,]
se.temp <- .summary.object$standard.errors[model.num,]
}
return( 2*pnorm( abs( (coef.temp) / (se.temp) ) , mean = 0, sd = 1, lower.tail = FALSE, log.p = FALSE) )
}
else if (model.name %in% c("betareg")) {
return(.summary.object$coefficients$mean[,"Pr(>|z|)"])
}
else if (model.name %in% c("gls")) {
coef.temp <- object.name$coefficients
se.temp <- sqrt(diag(object.name$varBeta))
t.temp <- coef.temp / se.temp
p.temp <- 2*pnorm( abs( t.temp ) , mean = 0, sd = 1, lower.tail = FALSE, log.p = FALSE)
return(p.temp)
}
else if (model.name %in% c("weibreg", "coxreg", "phreg", "aftreg", "bj", "cph", "Gls", "lrm", "ols", "psm", "Rq")) {
coef.temp <- object.name$coefficients
se.temp <- sqrt(diag(object.name$var))
t.temp <- coef.temp / se.temp
p.temp <- 2*pnorm( abs( t.temp ) , mean = 0, sd = 1, lower.tail = FALSE, log.p = FALSE)
return(p.temp)
}
else if (model.name %in% c("rem.dyad")) {
coef.temp <- object.name$coef
se.temp <- sqrt(diag(object.name$cov))
t.temp <- coef.temp / se.temp
p.temp <- 2*pnorm( abs( t.temp ) , mean = 0, sd = 1, lower.tail = FALSE, log.p = FALSE)
return(p.temp)
}
return(NULL)
}
.get.p.values <-
function(object.name, user.given=NULL, auto=TRUE, f.coef=NULL, f.se=NULL, user.coef=NULL, user.se=NULL, model.num=1) {
out <- .get.p.values.1(object.name, user.given, auto, f.coef, f.se, user.coef, user.se, model.num)
coef.vars <- .coefficient.variables(object.name)
if (is.null(names(out))) {
if (length(out) < length(coef.vars)) {
out.temp <- rep(NA, times=length(coef.vars)-length(out))
out <- c(out, out.temp)
}
else if (length(out) > length(coef.vars)) {
out <- out[1:length(coef.vars)]
}
names(out) <- coef.vars
}
else {
out.temp <- rep(NA, times = length(coef.vars))
names(out.temp) <- coef.vars
for (i in 1:length(out)) {
name <- names(out)[i]
if (name %in% coef.vars) {
out.temp[name] <- out[i]
}
}
out <- out.temp
}
return(out)
}
.get.scale <-
function(object.name) {
model.name <- .get.model.name(object.name)
if (!(model.name %in% c("arima","fGARCH","Arima","maBina", "coeftest", "Gls", "lmer", "glmer", "nlmer"))) {
if (!is.null(object.name$scale)) {
if (model.name %in% c("normal.gee", "logit.gee", "poisson.gee", "probit.gee", "gamma.gee", "gee()", "exp","lognorm","weibull","tobit","survreg()","tobit(AER)")) {
return(as.vector(object.name$scale))
}
}
}
return(NA)
}
.get.sigma2 <-
function(object.name) {
model.name <- .get.model.name(object.name)
if (model.name %in% c("arima","fGARCH","maBina", "coeftest", "Gls", "lmer", "glmer", "nlmer")) {
return(NA)
}
if (model.name %in% c("lagsarlm", "errorsarlm")) {
return(.summary.object$s2)
}
if (!is.null(object.name$sigma2)) {
return(as.vector(object.name$sigma2))
}
return(NA)
}
.get.rho <-
function(object.name) {
model.name <- .get.model.name(object.name)
rho.output <- as.vector(rep(NA,times=4))
if (model.name %in% c("selection")) {
i <- object.name$param$index$rho
if (is.null(i)) { i <- object.name$param$index$errTerms["rho"] }
if (!is.null(i)) {
rho.output <- as.vector(.summary.object$estimate[i,])
}
}
if (model.name %in% c("heckit")) {
if (object.name$method == "2step") {
i <- object.name$param$index$rho
rho.output <- as.vector(.summary.object$estimate[i,])
}
}
names(rho.output) <- c("statistic","se","tstat","p-value")
return(cbind(rho.output))
}
.get.mills <-
function(object.name) {
model.name <- .get.model.name(object.name)
mills.output <- as.vector(rep(NA,times=4))
if (model.name %in% c("heckit", "selection")) {
i <- object.name$param$index$Mills
if (!is.null(i)) {
mills.output <- as.vector(.summary.object$estimate[i,])
}
}
names(mills.output) <- c("statistic","se","tstat","p-value")
return(cbind(mills.output))
}
.get.standard.errors.1 <-
function(object.name, user.given=NULL, model.num=1) {
if (!is.null(user.given)) {
if (.model.identify(object.name) == "multinom") {
if (!is.null(nrow(user.given))) { user.given <- as.vector(user.given[model.num,]) }
}
return(user.given)
}
model.name <- .get.model.name(object.name)
if (model.name %in% c("ls", "normal", "logit", "probit", "relogit", "poisson", "negbin", "normal.survey", "poisson.survey", "probit.survey", "logit.survey", "gamma", "gamma.survey",
"cloglog.net", "gamma.net", "logit.net", "probit.net", "brglm", "glm()", "Glm()", "svyglm()", "plm", "pgmm", "ivreg", "lmrob", "glmrob", "dynlm", "gmm","mclogit")) {
return(.summary.object$coefficients[,"Std. Error"])
}
if (model.name %in% c("Arima")) {
return(sqrt(diag(object.name$var.coef)))
}
if (model.name %in% c("censReg")) {
return(.summary.object$estimate[,2])
}
if (model.name %in% c("mnlogit")) {
return(.summary.object$CoefTable[,2])
}
if (model.name %in% c("fGARCH")) {
return(object.name@fit$matcoef[,2])
}
if (model.name %in% c("lme", "nlme")) {
return(.summary.object$tTable[,2])
}
if (model.name %in% c("maBina")) {
return(as.vector(object.name$out[,2]))
}
if (model.name %in% c("mlogit")) {
return(as.vector(.summary.object$CoefTable[,2]))
}
if (model.name %in% c("coeftest")) {
return(as.vector(object.name[,2]))
}
if (model.name %in% c("selection","heckit")) {
if (!.global.sel.equation) {
indices <- .summary.object$param$index$betaO ### outcome equation
}
else {
indices <- .summary.object$param$index$betaS ### selection equation
}
return(as.vector(.summary.object$estimate[indices,2]))
}
if (model.name %in% c("probit.ss", "binaryChoice")) {
return(as.vector(.summary.object$estimate[,2]))
}
if (model.name %in% c("hetglm")) {
return(as.vector(.summary.object$coefficients$mean[,2]))
}
if (model.name %in% c("lmer", "glmer", "nlmer")) {
Vcov <- as.matrix(vcov(object.name, useScale = FALSE))
coefs <-.summary.object$coefficients[,1]
se <- sqrt(diag(Vcov))
names(se) <- names(coefs)
return(se)
}
if (model.name %in% c("lagsarlm", "errorsarlm")) {
return(.summary.object$Coef[,2])
}
if (model.name %in% c("ergm")) {
return(.summary.object$coefs[,2])
}
if (model.name %in% c("rq","felm")) {
return(.summary.object$coefficients[,2])
}
if (model.name %in% c("clm")) {
if (.format.ordered.intercepts == FALSE) {
return(.summary.object$coefficients[(length(object.name$alpha)+1):(length(object.name$coefficients)),2])
}
else {
return(.summary.object$coefficients[,2])
}
}
else if (model.name %in% c("pmg")) {
return (sqrt(diag(.summary.object$vcov)))
}
if (model.name %in% c("zeroinfl", "hurdle")) {
if (.global.zero.component == FALSE) {
return(.summary.object$coefficients$count[,"Std. Error"])
}
else {
return(.summary.object$coefficients$zero[,"Std. Error"])
}
}
else if (model.name %in% c("normal.gee", "logit.gee", "poisson.gee", "probit.gee", "gamma.gee", "gee()")) {
return(.summary.object$coefficients[,"Robust S.E."])
}
else if (model.name %in% c("normal.gam", "logit.gam", "probit.gam", "poisson.gam", "gam()")) {
temp.se <- .summary.object$se
names(temp.se) <- names(.summary.object$p.coeff)
return(temp.se)
}
else if (model.name %in% c("coxph")) {
return(.summary.object$coef[,"se(coef)"])
}
else if (model.name %in% c("clogit")) {
return(.summary.object$coef[,"se(coef)"])
}
else if (model.name %in% c("exp","lognorm","weibull","tobit","survreg()")) {
return(.summary.object$table[,"Std. Error"])
}
else if (model.name %in% c("rlm")) {
return(suppressMessages(.summary.object$coefficients[,"Std. Error"]))
}
else if (model.name %in% c("ologit", "oprobit", "polr()")) {
se.temp <- suppressMessages(.summary.object$coefficients[,"Std. Error"])
if (.format.ordered.intercepts == FALSE) { return(se.temp[seq(from=1, to=length(se.temp)-(length(suppressMessages(.summary.object$lev))-1))]) }
else { return(se.temp) }
}
else if (model.name %in% c("arima")) {
return( sqrt(diag(object.name$var.coef)) )
}
else if (model.name %in% c("tobit(AER)")){
return(.summary.object$coefficients[,"Std. Error"])
}
else if (model.name %in% c("multinom")) {
if (is.null(nrow(.summary.object$coefficients))) {
se.temp <- .summary.object$standard.errors
}
else {
se.temp <- .summary.object$standard.errors[model.num,]
}
return(se.temp)
}
else if (model.name %in% c("betareg")) {
return(.summary.object$coefficients$mean[,"Std. Error"])
}
else if (model.name %in% c("gls")) {
se.temp <- sqrt(diag(object.name$varBeta))
return(se.temp)
}
else if (model.name %in% c("weibreg", "coxreg", "phreg", "aftreg", "bj", "cph", "Gls", "lrm", "ols", "psm", "Rq")) {
return( sqrt(diag(object.name$var) ) )
}
else if (model.name %in% c("rem.dyad")) {
return( sqrt(diag(object.name$cov) ) )
}
return(NULL)
}
.get.standard.errors <-
function(object.name, user.given=NULL, model.num=1) {
out <- .get.standard.errors.1(object.name, user.given, model.num)
coef.vars <- .coefficient.variables(object.name)
if (is.null(names(out))) {
if (length(out) < length(coef.vars)) {
out.temp <- rep(NA, times=length(coef.vars)-length(out))
out <- c(out, out.temp)
}
else if (length(out) > length(coef.vars)) {
out <- out[1:length(coef.vars)]
}
names(out) <- coef.vars
}
else {
out.temp <- rep(NA, times = length(coef.vars))
names(out.temp) <- coef.vars
for (i in 1:length(out)) {
name <- names(out)[i]
if (name %in% coef.vars) {
out.temp[name] <- out[i]
}
}
out <- out.temp
}
return(out)
}
.get.ci.lb.1 <-
function(object.name, user.given=NULL, model.num=1) {
if (!is.null(user.given)) {
if (.model.identify(object.name) == "multinom") {
if (!is.null(nrow(user.given))) { user.given <- as.vector(user.given[model.num,]) }
}
return(user.given)
}
return(NULL)
}
.get.ci.lb <-
function(object.name, user.given=NULL, model.num=1) {
out <- .get.ci.lb.1(object.name, user.given, model.num)
coef.vars <- .coefficient.variables(object.name)
if (is.null(names(out))) {
if (length(out) < length(coef.vars)) {
out.temp <- rep(NA, times=length(coef.vars)-length(out))
out <- c(out, out.temp)
}
else if (length(out) > length(coef.vars)) {
out <- out[1:length(coef.vars)]
}
names(out) <- coef.vars
}
else {
out.temp <- rep(NA, times = length(coef.vars))
names(out.temp) <- coef.vars
for (i in 1:length(out)) {
name <- names(out)[i]
if (name %in% coef.vars) {
out.temp[name] <- out[i]
}
}
out <- out.temp
}
return(out)
}
.get.ci.rb.1 <-
function(object.name, user.given=NULL, model.num=1) {
if (!is.null(user.given)) {
if (.model.identify(object.name) == "multinom") {
if (!is.null(nrow(user.given))) { user.given <- as.vector(user.given[model.num,]) }
}
return(user.given)
}
return(NULL)
}
.get.ci.rb <-
function(object.name, user.given=NULL, model.num=1) {
out <- .get.ci.rb.1(object.name, user.given, model.num)
coef.vars <- .coefficient.variables(object.name)
if (is.null(names(out))) {
if (length(out) < length(coef.vars)) {
out.temp <- rep(NA, times=length(coef.vars)-length(out))
out <- c(out, out.temp)
}
else if (length(out) > length(coef.vars)) {
out <- out[1:length(coef.vars)]
}
names(out) <- coef.vars
}
else {
out.temp <- rep(NA, times = length(coef.vars))
names(out.temp) <- coef.vars
for (i in 1:length(out)) {
name <- names(out)[i]
if (name %in% coef.vars) {
out.temp[name] <- out[i]
}
}
out <- out.temp
}
return(out)
}
.get.t.stats.1 <-
function(object.name, user.given=NULL, auto=TRUE, f.coef=NULL, f.se=NULL, user.coef=NULL, user.se=NULL, model.num=1) {
if (!is.null(user.given)) {
if (.model.identify(object.name) == "multinom") {
if (!is.null(nrow(user.given))) {
user.given <- as.vector(user.given[model.num,])
}
}
return(user.given)
}
if (auto == TRUE) {
if ((!is.null(user.coef)) || (!is.null(user.se))) {
#if (.model.identify(object.name) == "multinom") {
# f.coef <- as.vector(f.coef[model.num,])
# f.se <- as.vector(f.se[model.num,])
#}
# set the lengths of the vectors to be equal to each other
coef.div <- .fill.NA(f.coef, f.se)
se.div <- .fill.NA(f.se, f.coef)
auto.return <- coef.div / se.div
names(auto.return) <- names(f.coef)
return(auto.return)
}
}
model.name <- .get.model.name(object.name)
if (model.name %in% c("ls", "normal", "logit", "probit", "relogit", "poisson", "negbin", "normal.survey", "poisson.survey", "probit.survey", "logit.survey", "gamma", "gamma.survey",
"cloglog.net", "gamma.net", "logit.net", "probit.net", "glm()", "Glm()", "svyglm()","plm", "pgmm", "ivreg", "lmrob", "glmrob", "dynlm", "gmm", "mclogit", "felm")) {
return(.summary.object$coefficients[,3])
}
if (model.name %in% c("censReg")) {
return(.summary.object$estimate[,3])
}
if (model.name %in% c("mnlogit")) {
return(.summary.object$CoefTable[,3])
}
if (model.name %in% c("fGARCH")) {
return(object.name@fit$matcoef[,3])
}
if (model.name %in% c("lme", "nlme")) {
return(.summary.object$tTable[,4])
}
if (model.name %in% c("coeftest")) {
return(as.vector(object.name[,3]))
}
if (model.name %in% c("maBina")) {
return(as.vector(object.name$out[,3]))
}
if (model.name %in% c("mlogit")) {
return(as.vector(.summary.object$CoefTable[,3]))
}
if (model.name %in% c("selection","heckit")) {
if (!.global.sel.equation) {
indices <- .summary.object$param$index$betaO ### outcome equation
}
else {
indices <- .summary.object$param$index$betaS ### selection equation
}
return(as.vector(.summary.object$estimate[indices,3]))
}
if (model.name %in% c("probit.ss", "binaryChoice")) {
return(as.vector(.summary.object$estimate[,3]))
}
if (model.name %in% c("hetglm")) {
return(as.vector(.summary.object$coefficients$mean[,3]))
}
if (model.name %in% c("lmer", "glmer", "nlmer")) {
Vcov <- as.matrix(vcov(object.name, useScale = FALSE))
coefs <- .summary.object$coefficients[,1]
se <- sqrt(diag(Vcov))
tstat <- coefs / se
names(tstat) <- names(coefs)
return(tstat)
}
if (model.name %in% c("ergm")) {
return((.summary.object$coefs[,1])/(.summary.object$coefs[,2]))
}
if (model.name %in% c("lagsarlm", "errorsarlm")) {
return(.summary.object$Coef[,3])
}
if (model.name %in% c("rq")) {
return(.summary.object$coefficients[,3])
}
if (model.name %in% c("clm")) {
if (.format.ordered.intercepts == FALSE) {
return(.summary.object$coefficients[(length(object.name$alpha)+1):(length(object.name$coefficients)),3])
}
else {
return(.summary.object$coefficients[,3])
}
}
else if (model.name %in% c("pmg")) {
coef.temp <- .summary.object$coef
std.err.temp <- sqrt(diag(.summary.object$vcov))
t.stat.temp <- coef.temp / std.err.temp
return(t.stat.temp)
}
else if (model.name %in% c("zeroinfl", "hurdle")) {
if (.global.zero.component == FALSE) {
return(.summary.object$coefficients$count[,3])
}
else {
return(.summary.object$coefficients$zero[,3])
}
}
else if (model.name %in% c("normal.gee", "logit.gee", "poisson.gee", "probit.gee", "gamma.gee", "gee()")) {
return(.summary.object$coefficients[,"Robust z"])
}
else if (model.name %in% c("normal.gam", "logit.gam", "probit.gam", "poisson.gam", "gam()")) {
return(.summary.object$p.t)
}
else if (model.name %in% c("coxph", "clogit")) {
return(.summary.object$coef[,"z"])
}
else if (model.name %in% c("exp","lognorm","weibull", "tobit","survreg()")) {
return(.summary.object$table[,"z"])
}
else if (model.name %in% c("rlm")) {
return(suppressMessages(.summary.object$coefficients[,"t value"]))
}
else if (model.name %in% c("ologit", "oprobit", "polr()")) {
tstat.temp <- suppressMessages(.summary.object$coefficients[,"t value"])
if (.format.ordered.intercepts == FALSE) { return(tstat.temp[seq(from=1, to=length(tstat.temp)-(length(suppressMessages(.summary.object$lev))-1))]) }
else { return(tstat.temp) }
}
else if (model.name %in% c("arima")) {
return( object.name$coef / (sqrt(diag(object.name$var.coef))) )
}
else if (model.name %in% c("tobit(AER)")){
return(.summary.object$coefficients[,"z value"])
}
else if (model.name %in% c("multinom")) {
if (is.null(nrow(.summary.object$coefficients))) {
coef.temp <- .summary.object$coefficients
se.temp <- .summary.object$standard.errors
}
else {
coef.temp <- .summary.object$coefficients[model.num,]
se.temp <- .summary.object$standard.errors[model.num,]
}
return( (coef.temp) / (se.temp) )
}
else if (model.name %in% c("betareg")) {
return(.summary.object$coefficients$mean[,"z value"])
}
else if (model.name %in% c("gls")) {
coef.temp <- object.name$coefficients
se.temp <- sqrt(diag(object.name$varBeta))
return(coef.temp / se.temp)
}
else if (model.name %in% c("weibreg", "coxreg", "phreg", "aftreg", "bj", "cph", "Gls", "lrm", "ols", "psm", "Rq")) {
coef.temp <- object.name$coefficients
se.temp <- sqrt(diag(object.name$var))
return(coef.temp / se.temp )
}
else if (model.name %in% c("Arima")) {
coef.temp <- object.name$coef
se.temp <- sqrt(diag(object.name$var.coef))
return(coef.temp / se.temp )
}
else if (model.name %in% c("rem.dyad")) {
coef.temp <- object.name$coef
se.temp <- sqrt(diag(object.name$cov))
return(coef.temp / se.temp )
}
return(NULL)
}
.get.t.stats <-
function(object.name, user.given=NULL, auto=TRUE, f.coef=NULL, f.se=NULL, user.coef=NULL, user.se=NULL, model.num=1) {
out <- .get.t.stats.1(object.name, user.given, auto, f.coef, f.se, user.coef, user.se, model.num)
coef.vars <- .coefficient.variables(object.name)
if (is.null(names(out))) {
if (length(out) < length(coef.vars)) {
out.temp <- rep(NA, times=length(coef.vars)-length(out))
out <- c(out, out.temp)
}
else if (length(out) > length(coef.vars)) {
out <- out[1:length(coef.vars)]
}
names(out) <- coef.vars
}
else {
out.temp <- rep(NA, times = length(coef.vars))
names(out.temp) <- coef.vars
for (i in 1:length(out)) {
name <- names(out)[i]
if (name %in% coef.vars) {
out.temp[name] <- out[i]
}
}
out <- out.temp
}
return(out)
}
.get.theta <-
function(object.name) {
theta.output <- as.vector(rep(NA,times=4))
model.name <- .get.model.name(object.name)
if (!(model.name %in% c("arima","fGARCH","Arima","maBina", "coeftest", "Gls", "lmer", "glmer", "nlmer"))) {
if ((!is.null(object.name$theta)) && (!is.null(object.name$SE.theta))) {
theta.value <- object.name$theta
theta.se.value <- object.name$SE.theta
theta.tstat.value <- theta.value / theta.se.value
theta.p.value <- 2*pnorm(abs(theta.tstat.value), mean = 0, sd = 1, lower.tail = FALSE, log.p = FALSE)
theta.output <- as.vector(c(theta.value, theta.se.value, theta.tstat.value, theta.p.value))
}
}
names(theta.output) <- c("statistic","se","tstat","p-value")
return(cbind(theta.output))
}
.inside.bracket <-
function(s) {
process.string <- ""
return.vector <- NULL
if (!is.character(s)) { return("") }
if (is.null(s)) { return("") }
if (is.na(s)) { return("") }
if (s=="") { return("") }
if (length(s) > 1) { return("") }
inside.inner.bracket <- 0
for (i in seq(from = (regexpr("(",s,fixed=TRUE)[1])+1, to = nchar(s))) {
letter <- substr(s,i,i)
if (letter == "(") { inside.inner.bracket <- inside.inner.bracket + 1 }
if (letter == ")") { inside.inner.bracket <- inside.inner.bracket - 1 }
if ((letter == ",") && (inside.inner.bracket == 0)) {
return.vector <- c(return.vector, process.string)
process.string <- ""
}
else if (inside.inner.bracket >= 0) { process.string <- paste(process.string, letter, sep="") }
else { break }
}
if (process.string != "") { return.vector <- c(return.vector, process.string) }
return (.trim(return.vector))
}
.iround <-
function(x, decimal.places=0, round.up.positive=FALSE, simply.output=FALSE) {
x.original <- x
first.part <- ""
if (is.na(x) || is.null(x)) { return("") }
if (simply.output == TRUE) {
if (!is.numeric(x)) { return(.remove.special.chars(x)) }
}
if (x.original < 0) { x <- abs(x) }
if (!is.na(decimal.places)) {
if ((.format.until.nonzero.digit == FALSE) || (decimal.places <= 0)) {
round.result <- round(x, digits=decimal.places)
}
else {
temp.places <- decimal.places
if (!.is.all.integers(x)) {
while ((round(x, digits=temp.places) == 0) && (temp.places < (decimal.places + .format.max.extra.digits))) {
temp.places <- temp.places + 1
}
}
round.result <- round(x, digits=temp.places)
decimal.places <- temp.places
}
if ((round.up.positive==TRUE) && (round.result < x)) { # useful for p-values that should be rounded up
if (x > (10^((-1)*(decimal.places+1)))) {
round.result <- round.result + 10^((-1)*decimal.places)
}
else { round.result <- 0 }
}
}
else { # if the decimal place is NA
round.result <- x
}
round.result.char <- as.character(format(round.result, scientific=FALSE))
split.round.result <- unlist(strsplit(round.result.char, "\\."))
## first deal with digit separator
for (i in seq(from=1, to=length(.format.digit.separator.where))) {
if (.format.digit.separator.where[i]<=0) {
.format.digit.separator.where[i] <<- -1
}
}
separator.count <- 1
length.integer.part <- nchar(split.round.result[1])
digits.in.separated.unit <- 0
for (i in seq(from=length.integer.part, to=1)) {
if ((digits.in.separated.unit == .format.digit.separator.where[separator.count]) && (substr(split.round.result[1],i,i)!="-")){
first.part <- paste(.format.digit.separator,first.part,sep="")
if (separator.count < length(.format.digit.separator.where)) { separator.count <- separator.count + 1 }
digits.in.separated.unit <- 0
}
first.part <- paste(substr(split.round.result[1],i,i),first.part,sep="")
digits.in.separated.unit <- digits.in.separated.unit + 1
}
# remove initial zero and there are decimal places, if that is requested
if (.format.initial.zero==FALSE) {
if ((round.result > 0) && (round.result < 1)) {
if ((is.na(decimal.places)) || (decimal.places > 0)) {
first.part <- ""
}
}
}
if (x.original < 0) { # use math-mode for a better looking negative sign
if (.format.dec.mark.align == TRUE) {
first.part <- paste("-", first.part, sep="")
}
else {
first.part <- paste("$-$", first.part, sep="")
}
}
# now deal with the decimal part
if (!is.na(decimal.places)) {
if (decimal.places <= 0) {
return(first.part)
}
}
if (length(split.round.result)==2) {
if (is.na(decimal.places)) { return(paste(first.part,.format.decimal.character,split.round.result[2],sep="")) }
if (nchar(split.round.result[2]) < decimal.places) {
decimal.part <- split.round.result[2]
for (i in seq(from = 1,to = (decimal.places - nchar(split.round.result[2])))) {
decimal.part <- paste(decimal.part,"0", sep="")
}
return(paste(first.part,.format.decimal.character,decimal.part,sep=""))
}
else { return(paste(first.part,.format.decimal.character,split.round.result[2],sep="")) }
}
else if (length(split.round.result)==1) {
if (is.na(decimal.places)) { return(paste(first.part,.format.decimal.character,decimal.part,sep="")) }
decimal.part <- ""
for (i in seq(from = 1,to = decimal.places)) {
decimal.part <- paste(decimal.part,"0", sep="")
}
return(paste(first.part,.format.decimal.character,decimal.part,sep=""))
}
else { return(NULL) }
}
is.wholenumber <-
function(x, tol = .Machine$double.eps^0.5) abs(x - round(x)) < tol
.is.all.integers <-
function(x) {
if (!is.numeric(x)) { return(FALSE) }
if (length(x[!is.na(x)]) == length(is.wholenumber(x)[(!is.na(x)) & (is.wholenumber(x)==TRUE)])) {
return(TRUE)
}
else { return (FALSE) }
}
.log.likelihood <-
function(object.name) {
model.name <- .get.model.name(object.name)
if (model.name %in% c("coeftest","maBina","gamma.net","logit.net","probit.net","cloglog.net")) {
return(NA)
}
if (model.name %in% c("fGARCH")) {
return(object.name@fit$value)
}
if (model.name %in% c("mlogit", "mnlogit")) {
return(as.vector(object.name$logLik[1]))
}
if (model.name %in% c("arima", "betareg", "zeroinfl", "hurdle", "hetglm", "Arima")) {
return(as.vector(object.name$loglik))
}
if (model.name %in% c("selection","binaryChoice", "probit.ss")) {
return(as.vector(.summary.object$loglik))
}
if (model.name %in% c("lme","nlme","lmer", "glmer", "nlmer","censReg")) {
return(as.vector(logLik(object.name)[1]))
}
if (model.name %in% c("lagsarlm", "errorsarlm")) {
return(as.vector(.summary.object$LL))
}
if (model.name %in% c("clm", "gls")) {
return(as.vector(object.name$logLik))
}
else if (model.name %in% c("coxph", "clogit", "exp", "weibull", "lognorm","tobit", "tobit(AER)", "survreg()")) {
return(as.vector(.summary.object$loglik[2]))
}
else if (model.name %in% c("weibreg", "coxreg", "phreg", "aftreg")) {
return(as.vector(object.name$loglik[2]))
}
else if (!is.null(object.name$aic)) {
return(as.vector(-(0.5)*(object.name$aic-2*length(.summary.object$coefficients[,"Estimate"]))))
}
return(NA)
}
.logrank.stat <-
function(object.name) {
logrank.output <- as.vector(rep(NA,times=3))
model.name <- .get.model.name(object.name)
if (!(model.name %in% c("arima","fGARCH","Arima","maBina", "coeftest", "Gls", "lmer", "glmer", "nlmer"))) {
if (!is.null(.summary.object$logtest)) {
logrank.value <- suppressMessages(.summary.object$sctest[1])
df.value <- suppressMessages(.summary.object$sctest[2])
logrank.p.value <- suppressMessages(.summary.object$sctest[3])
logrank.output <- as.vector(c(logrank.value, df.value, logrank.p.value))
}
}
names(logrank.output) <- c("statistic","df1","p-value")
return(cbind(logrank.output))
}
.lr.stat <-
function(object.name) {
log.output <- as.vector(rep(NA,times=3))
model.name <- .get.model.name(object.name)
if (model.name %in% c("mlogit")) {
log.value <- as.vector(.summary.object$lratio$statistic["chisq"])
if (!is.null(log.value)) {
df.value <- as.vector(length(object.name$coeff))
log.p.value <- as.vector(pchisq(log.value,df.value,lower.tail=FALSE))
log.output <- as.vector(c(log.value, df.value, log.p.value))
}
}
else if (model.name %in% c("lagsarlm", "errorsarlm")) {
log.value <- as.vector(.summary.object$LR1$statistic)
df.value <- as.vector(.summary.object$LR1$parameter)
log.p.value <- as.vector(.summary.object$LR1$p.value)
log.output <- as.vector(c(log.value, df.value, log.p.value))
}
else if (!(model.name %in% c("arima","fGARCH","Arima","maBina","coeftest","Gls","lmer","glmer","nlmer"))) {
if (!is.null(.summary.object$logtest)) {
log.value <- suppressMessages(.summary.object$logtest[1])
df.value <- suppressMessages(.summary.object$logtest[2])
log.p.value <- suppressMessages(.summary.object$logtest[3])
log.output <- as.vector(c(log.value, df.value, log.p.value))
}
}
names(log.output) <- c("statistic","df1","p-value")
return(cbind(log.output))
}
.max.r.squared <-
function(object.name) {
model.name <- .get.model.name(object.name)
if (!(model.name %in% c("arima","fGARCH","fGARCH","Arima","maBina", "coeftest", "lmer", "glmer", "nlmer", "Gls", "Arima"))) {
if (model.name %in% c("coxph", "clogit")) {
return(as.vector(.summary.object$rsq[2]))
}
}
return(NA)
}
.model.identify <-
function(object.name) {
if (class(object.name)[1]=="NULL") { #### !!!!! continue this
return("NULL")
}
if (class(object.name)[1]=="Arima") {
return("Arima")
}
if (class(object.name)[1]=="fGARCH") {
return("fGARCH")
}
if (class(object.name)[1]=="censReg") {
return("censReg")
}
if (class(object.name)[1]=="ergm") {
return("ergm")
}
if (class(object.name)[1]=="mnlogit") {
return("mnlogit")
}
if (class(object.name)[1]=="lme") {
return("lme")
}
if (class(object.name)[1]=="nlme") {
return("nlme")
}
if (class(object.name)[1]=="felm") {
return("felm")
}
if (class(object.name)[1] %in% c("mclogit","mclogitRandeff")) {
return("mclogit")
}
if (class(object.name)[1]=="mlogit") {
return("mlogit")
}
if (class(object.name)[1]=="maBina") {
return("maBina")
}
if (class(object.name)[1]=="coeftest") {
return("coeftest")
}
if (class(object.name)[1]=="rem.dyad") {
return("rem.dyad")
}
if (class(object.name)[1]=="lmerMod") {
return("lmer")
}
if (class(object.name)[1]=="glmerMod") {
return("glmer")
}
if (class(object.name)[1]=="nlmerMod") {
return("nlmer")
}
if (!is.null(object.name$call)) {
if (object.name$call[1]=="lm()") { return("ls") }
else if ((object.name$call[1]=="glm()") || (object.name$call[1]=="Glm()")) {
if (object.name$family$family=="gaussian") {
if (object.name$family$link=="identity") {
return("normal")
}
}
else if (object.name$family$family=="binomial") {
if (object.name$family$link=="probit") {
return("probit")
}
if (object.name$family$link=="logit") {
return("logit")
}
}
else if (object.name$family$family=="poisson") {
if (object.name$family$link=="log") {
return("poisson")
}
}
else if (object.name$family$family=="Gamma") {
if (object.name$family$link=="inverse") {
return("gamma")
}
}
return(paste("glm()#",object.name$family$family,"#",object.name$family$link, sep=""))
}
else if (object.name$call[1]=="svyglm()") {
if (object.name$family$family=="gaussian") {
if (object.name$family$link=="identity") {
return("normal.survey")
}
}
else if ((object.name$family$family=="binomial") || (object.name$family$family=="quasibinomial")) {
if (object.name$family$link=="probit") {
return("probit.survey")
}
if (object.name$family$link=="logit") {
return("logit.survey")
}
}
else if (object.name$family$family=="poisson") {
if (object.name$family$link=="log") {
return("poisson.survey")
}
}
else if (object.name$family$family=="Gamma") {
if (object.name$family$link=="inverse") {
return("gamma.survey")
}
}
return(paste("svyglm()#",object.name$family$family,"#",object.name$family$link, sep=""))
}
else if (object.name$call[1]=="gam()") {
if (object.name$family$family=="gaussian") {
if (object.name$family$link=="identity") {
return("normal.gam")
}
}
else if (object.name$family$family=="binomial") {
if (object.name$family$link=="probit") {
return("probit.gam")
}
if (object.name$family$link=="logit") {
return("logit.gam")
}
}
else if (object.name$family$family=="poisson") {
if (object.name$family$link=="log") {
return("poisson.gam")
}
}
else if (object.name$family$family=="Gamma") {
if (object.name$family$link=="inverse") {
return("gamma.gam")
}
}
return(paste("gam()#",object.name$family$family,"#",object.name$family$link, sep=""))
}
else if (object.name$call[1]=="polr()") {
if (object.name$method=="logistic") {
return("ologit")
}
else if (object.name$method=="probit") {
return("oprobit")
}
return(paste("polr()#",object.name$method, sep=""))
}
else if (object.name$call[1]=="gee()") {
if (object.name$family$family=="gaussian") {
if (object.name$family$link=="identity") {
return("normal.gee")
}
}
else if (object.name$family$family=="binomial") {
if (object.name$family$link=="probit") {
return("probit.gee")
}
if (object.name$family$link=="logit") {
return("logit.gee")
}
}
else if (object.name$family$family=="poisson") {
if (object.name$family$link=="log") {
return("poisson.gee")
}
}
else if (object.name$family$family=="Gamma") {
if (object.name$family$link=="inverse") {
return("gamma.gee")
}
}
return(paste("gee()#",object.name$family$family,"#",object.name$family$link, sep=""))
}
else if (object.name$call[1]=="survreg()") {
if (object.name$dist=="exponential") {
return("exp")
}
else if (object.name$dist=="weibull") {
return("weibull")
}
else if (object.name$dist=="lognorm") {
return("lognormal")
}
else if (object.name$dist=="gaussian") {
return("tobit")
}
return(paste("survreg()#",object.name$dist, sep=""))
}
else if (object.name$call[1]=="glm.nb()") {
return("negbin")
}
else if (object.name$call[1]=="\"glm.nb\"()") {
return("negbin")
}
if (!is.null(object.name$userCall)) {
if (object.name$userCall[1]=="clogit()") {
return("clogit")
}
}
if (object.name$call[1]=="coxph()") {
return("coxph")
}
if (object.name$call[1]=="pmg()") {
return("pmg")
}
if (object.name$call[1]=="selection()") {
return("selection")
}
if (object.name$call[1]=="heckit()") {
return("heckit")
}
if (object.name$call[1]=="probit()") {
return("probit.ss")
}
if (object.name$call[1]=="binaryChoice()") {
return("binaryChoice")
}
if (object.name$call[1]=="brglm()") {
return("brglm")
}
if (object.name$call[1]=="gls()") {
return("gls")
}
if (object.name$call[1]=="clm()") {
return("clm")
}
if (object.name$call[1]=="lmrob()") {
return("lmrob")
}
if (object.name$call[1]=="glmrob()") {
return("glmrob")
}
if (object.name$call[1]=="dynlm()") {
return("dynlm")
}
if (object.name$call[1]=="rq()") {
return("rq")
}
if (object.name$call[1]=="gmm()") {
return("gmm")
}
if (object.name$call[1]=="lagsarlm()") {
return("lagsarlm")
}
if (object.name$call[1]=="errorsarlm()") {
return("errorsarlm")
}
if (object.name$call[1]=="rlm()") {
return("rlm")
}
if (object.name$call[1]=="aftreg()") {
return("aftreg")
}
if (object.name$call[1]=="coxreg()") {
return("coxreg")
}
if (object.name$call[1]=="phreg()") {
return("phreg")
}
if (object.name$call[1]=="weibreg()") {
return("weibreg")
}
if (object.name$call[1]=="bj()") {
return("bj")
}
if (object.name$call[1]=="cph()") {
return("cph")
}
if (object.name$call[1]=="Gls()") {
return("Gls")
}
if (object.name$call[1]=="lrm()") {
return("lrm")
}
if (object.name$call[1]=="ols()") {
return("ols")
}
if (object.name$call[1]=="psm()") {
return("psm")
}
if (object.name$call[1]=="Rq()") {
return("Rq")
}
if (object.name$call[1]=="hetglm()") {
return("hetglm")
}
else if (object.name$call[1]=="relogit()") {
return("relogit")
}
else if (object.name$call[1]=="netbinom()") {
if (object.name$call$LF=="probit") { return("probit.net") }
if (object.name$call$LF=="logit") { return("logit.net") }
if (object.name$call$LF=="cloglog") { return("cloglog.net") }
}
else if (object.name$call[1]=="netgamma()") {
return("gamma.net")
}
else if (object.name$call[1]=="zelig()") {
if (object.name$call$model %in% c("ls","normal","logit","probit","relogit","poisson","poisson.survey",
"negbinom","probit.survey","logit.survey","normal.gee","logit.gee","probit.gee",
"poisson.gee","normal.gam","logit.gam","probit.gam","poisson.gam","exp",
"coxph","weibull","lognorm","normal.survey","gamma","gamma.survey",
"gamma.gee","cloglog.net","logit.net","probit.net","gamma.net","ologit",
"oprobit","arima","tobit")) {
return(object.name$call$model)
}
else { return("unsupported zelig") }
}
else if (object.name$call[1]=="tobit()") {
return("tobit(AER)")
}
else if (object.name$call[1]=="multinom()") {
return("multinom")
}
else if (object.name$call[1]=="betareg()") {
return("betareg")
}
else if (object.name$call[1]=="zeroinfl()") {
return("zeroinfl")
}
else if (object.name$call[1]=="hurdle()") {
return("hurdle")
}
else if (object.name$call[1]=="plm()") {
return("plm")
}
else if (object.name$call[1]=="pgmm()") {
return("pgmm")
}
else if (object.name$call[1]=="ivreg()") {
return("ivreg")
}
}
return("unknown")
}
.new.table <-
function(object.name, user.coef=NULL, user.se=NULL, user.t=NULL, user.p=NULL, auto.t=TRUE, auto.p=TRUE, user.ci.lb=NULL, user.ci.rb=NULL) {
if (class(object.name)[1] == "Glm") {
.summary.object <<- summary.glm(object.name)
}
else if (!(.model.identify(object.name) %in% c("aftreg", "coxreg","phreg","weibreg", "bj", "cph", "Gls", "lrm", "ols", "psm", "Rq"))) {
.summary.object <<- summary(object.name)
}
else {
.summary.object <<- object.name
}
if (.model.identify(object.name) == "rq") {
.summary.object <<- suppressMessages(summary(object.name, se=.format.rq.se))
}
model.num.total <- 1 # model number for multinom, etc.
if (.model.identify(object.name) == "multinom") {
if (!is.null(nrow(.summary.object$coefficients))) {
model.num.total <- nrow(.summary.object$coefficients)
}
}
# set to null
.global.models <<- NULL
.global.dependent.variables <<- NULL
.global.dependent.variables.written <<- NULL
.global.coefficient.variables <<- NULL
.global.coef.vars.by.model <<- NULL
.global.coefficients <<- NULL
.global.std.errors <<- NULL
.global.ci.lb <<- NULL
.global.ci.rb <<- NULL
.global.t.stats <<- NULL
.global.p.values <<- NULL
.global.N <<- NULL
.global.LL <<- NULL
.global.R2 <<- NULL
.global.max.R2 <<- NULL
.global.adj.R2 <<- NULL
.global.AIC <<- NULL
.global.BIC <<- NULL
.global.scale <<- NULL
.global.UBRE <<- NULL
.global.sigma2 <<- NULL
.global.theta <<- NULL
.global.rho <<- NULL
.global.mills <<- NULL
.global.SER <<- NULL
.global.F.stat <<- NULL
.global.chi.stat <<- NULL
.global.wald.stat <<- NULL
.global.lr.stat <<- NULL
.global.logrank.stat <<- NULL
.global.null.deviance <<- NULL
.global.residual.deviance <<- NULL
for (model.num in 1:model.num.total) {
.global.models <<- c(.global.models, suppressMessages(as.vector(.model.identify(object.name))))
.global.dependent.variables <<- c(.global.dependent.variables, suppressMessages(.dependent.variable(object.name, model.num)))
.global.dependent.variables.written <<- c(.global.dependent.variables.written, suppressMessages(.dependent.variable.written(object.name, model.num)))
.global.coefficient.variables <<- suppressMessages(.coefficient.variables(object.name))
.global.coef.vars.by.model <<- suppressMessages(cbind(.global.coef.vars.by.model, .global.coefficient.variables))
get.coef <- suppressMessages(.get.coefficients(object.name, user.coef, model.num=model.num))
get.se <- suppressMessages(.get.standard.errors(object.name, user.se, model.num=model.num))
.global.coefficients <<- cbind(.global.coefficients, get.coef)
.global.std.errors <<- cbind(.global.std.errors, get.se)
.global.ci.lb <<- suppressMessages(cbind(.global.ci.lb, .get.ci.lb(object.name, user.ci.lb, model.num=model.num)))
.global.ci.rb <<- suppressMessages(cbind(.global.ci.rb, .get.ci.rb(object.name, user.ci.rb, model.num=model.num)))
feed.coef <- NA; feed.se <- NA
if (!is.null(get.coef)) { feed.coef <- get.coef }
if (!is.null(get.se)) { feed.se <- get.se }
if (!is.null(user.coef)) { feed.coef <- user.coef } # feed user-defined coefficients, if available
if (!is.null(user.se)) { feed.se <- user.se } # feed user-defined std errors, if available
.global.t.stats <<- suppressMessages(cbind(.global.t.stats, .get.t.stats(object.name, user.t, auto.t, feed.coef, feed.se, user.coef, user.se, model.num=model.num)))
.global.p.values <<- suppressMessages(cbind(.global.p.values, .get.p.values(object.name, user.p, auto.p, feed.coef, feed.se, user.coef, user.se, model.num=model.num)))
.global.N <<- c(.global.N, suppressMessages(.number.observations(object.name)))
.global.LL <<- c(.global.LL, suppressMessages(.log.likelihood(object.name)))
.global.R2 <<- c(.global.R2, suppressMessages(.r.squared(object.name)))
.global.max.R2 <<- c(.global.max.R2, suppressMessages(.max.r.squared(object.name)))
.global.adj.R2 <<- c(.global.adj.R2, suppressMessages(.adj.r.squared(object.name)))
.global.AIC <<- c(.global.AIC, suppressMessages(.AIC(object.name)))
.global.BIC <<- c(.global.BIC, suppressMessages(.BIC(object.name)))
.global.scale <<- c(.global.scale, suppressMessages(.get.scale(object.name)))
.global.UBRE <<- c(.global.UBRE, suppressMessages(.gcv.UBRE(object.name)))
.global.sigma2 <<- c(.global.sigma2, suppressMessages(.get.sigma2(object.name)))
.global.rho <<- cbind(suppressMessages(.get.rho(object.name)))
.global.mills <<- cbind(suppressMessages(.get.mills(object.name)))
.global.theta <<- cbind(suppressMessages(.get.theta(object.name)))
.global.SER <<- cbind(suppressMessages(.SER(object.name)))
.global.F.stat <<- cbind(suppressMessages(.F.stat(object.name)))
.global.chi.stat <<- cbind(suppressMessages(.chi.stat(object.name)))
.global.wald.stat <<- cbind(suppressMessages(.wald.stat(object.name)))
.global.lr.stat <<- cbind(suppressMessages(.lr.stat(object.name)))
.global.logrank.stat <<- cbind(suppressMessages(.logrank.stat(object.name)))
.global.null.deviance <<- cbind(suppressMessages(.null.deviance(object.name)))
.global.residual.deviance <<- cbind(suppressMessages(.residual.deviance(object.name)))
}
}
.null.deviance <-
function(object.name) {
null.deviance.output <- as.vector(rep(NA,times=3))
model.name <- .get.model.name(object.name)
if (!(model.name %in% c("arima","fGARCH","Arima","coeftest","Gls","lmer","glmer","nlmer", "ergm"))) {
if (model.name %in% c("rem.dyad", "mclogit")) {
null.deviance.value <- object.name$null.deviance
null.deviance.output <- as.vector(c(null.deviance.value, NA, NA))
}
else if (model.name %in% c("maBina")) {
null.deviance.value <- object.name$w$null.deviance
df.value <- object.name$w$df.null
null.deviance.output <- as.vector(c(null.deviance.value, df.value, NA))
}
else if (!is.null(suppressMessages(.summary.object$null.deviance))) {
null.deviance.value <- suppressMessages(.summary.object$null.deviance)
df.value <- object.name$df.null
null.deviance.output <- as.vector(c(null.deviance.value, df.value, NA))
}
else if (!is.null(object.name$null.deviance)) {
null.deviance.value <- object.name$null.deviance
df.value <- object.name$df.null
null.deviance.output <- as.vector(c(null.deviance.value, df.value, NA))
}
}
names(null.deviance.output) <- c("statistic","df1","p-value")
return(cbind(null.deviance.output))
}
.number.observations <-
function(object.name) {
model.name <- .get.model.name(object.name)
if (model.name %in% c("ls", "normal", "logit", "probit", "relogit",
"poisson", "negbin", "normal.survey", "poisson.survey",
"probit.survey", "logit.survey", "gamma", "gamma.survey",
"z.arima", "brglm","glm()", "Glm()", "svyglm()")) {
return(length(object.name$residuals))
}
else if (model.name %in% c("fGARCH")) {
return(length(object.name@data))
}
else if (model.name %in% c("maBina")) {
return(length(object.name$w$residuals))
}
else if (model.name %in% c("mlogit")) {
return(sum(object.name$freq))
}
else if (model.name %in% c("felm")) {
return(object.name$N)
}
else if (model.name %in% c("mclogit")) {
return(object.name$N)
}
else if (model.name %in% c("selection", "heckit")) {
return(.summary.object$param$nObs)
}
else if (model.name %in% c("binaryChoice", "probit.ss")) {
return(object.name$param$nObs)
}
else if (model.name %in% c("lmer","glmer","nlmer")) {
return(length(resid(object.name)))
}
else if (model.name %in% c("gmm")) {
return(object.name$n)
}
else if (model.name %in% c("plm", "pgmm", "pmg", "rlm", "lmrob", "glmrob", "dynlm", "rq", "lagsarlm", "errorsarlm", "rem.dyad")) {
return(as.vector(length(object.name$residual)))
}
else if (model.name %in% c("mnlogit")) {
return(as.vector(.summary.object$model.size$N))
}
else if (model.name %in% c("hurdle", "zeroinfl")) {
return(as.vector(object.name$n))
}
else if (model.name %in% c("ivreg","clm","hetglm")) {
return(as.vector(object.name$nobs))
}
if (model.name %in% c("normal.gee", "logit.gee", "poisson.gee",
"probit.gee", "gamma.gee", "gee()", "betareg")) {
return(as.vector(.summary.object$nobs))
}
else if (model.name %in% c("normal.gam", "logit.gam", "probit.gam",
"poisson.gam", "coxph", "clogit", "exp", "lognorm", "weibull", "survreg()",
"gam()")) {
return(as.vector(.summary.object$n))
}
else if (model.name %in% c("ologit", "oprobit", "polr()")) {
return(as.vector(.summary.object$nobs))
}
else if (model.name %in% c("gls")) {
return(as.vector(object.name$dims$N))
}
else if (model.name %in% c("tobit(AER)")) {
return(as.vector(.summary.object$n["Total"]))
}
else if (model.name %in% c("Arima","censReg","lme","nlme","weibreg", "coxreg", "phreg", "aftreg", "bj", "cph", "Gls", "lrm", "ols", "psm", "Rq")) {
return(as.vector(nobs(object.name)))
}
return(NA)
}
.rename.intercept <-
function(x) {
out <- x
for (i in seq(1:length(x))) {
if (x[i] %in% .global.intercept.strings) {
out[i] <- .format.intercept.name
}
}
return(out)
}
.order.reg.table <-
function(order) {
# first, find the position of the intercept and rename the variable to be the intercept string
intercept.position <- NULL
for (i in seq(1:length(.global.coefficient.variables))) {
if (.global.coefficient.variables[i] %in% .global.intercept.strings) {
intercept.position <- i
.global.coefficient.variables[i] <<- .format.intercept.name
rownames(.global.coefficients)[i] <<- .format.intercept.name
rownames(.global.std.errors)[i] <<- .format.intercept.name
rownames(.global.ci.lb)[i] <<- .format.intercept.name
rownames(.global.ci.rb)[i] <<- .format.intercept.name
rownames(.global.t.stats)[i] <<- .format.intercept.name
rownames(.global.p.values)[i] <<- .format.intercept.name
}
}
# put intercept on bottom if necessary
if (!is.null(intercept.position)) {
# hold contents of last row in placeholder variables
placehold.coefficient.variables <- .global.coefficient.variables[-intercept.position]
intercept.coefficient.variables <- .global.coefficient.variables[intercept.position]
if (.format.intercept.bottom) {
.global.coefficient.variables <<- c(placehold.coefficient.variables, intercept.coefficient.variables)
}
if (.format.intercept.top) {
.global.coefficient.variables <<- c(intercept.coefficient.variables, placehold.coefficient.variables)
}
}
# order according to user's wishes
old.order <- 1:length(.global.coefficient.variables)
new.order <- NULL; add.these <- NULL
if (!is.null(order)) {
# if order is regular expression...
if (is.character(order)) {
not.ordered.yet <- .global.coefficient.variables
for (i in 1:length(order)) {
add.these <- grep(order[i], not.ordered.yet, perl=.format.perl, fixed=FALSE)
not.ordered.yet[add.these] <- NA
if (length(add.these) != 0) {
new.order <- c(new.order, add.these)
}
}
}
else if (is.numeric(order)) { # if order contains indices
order <- unique(order)
order <- order[order <= max(old.order)]
new.order <- old.order[order]
}
}
if (!is.null(new.order)) {
remainder <- old.order[-new.order]
new.order <- c(new.order, remainder)
}
else { new.order <- old.order }
# set the right order
.global.coefficient.variables[old.order] <<- .global.coefficient.variables[new.order]
}
.insert.col.front <- function(d, new.col) {
# values
d.new <- d
d.new[,seq(2,ncol(d)+1)] <- d[,seq(1,ncol(d))]
d.new[,1] <- new.col
# column names
if (!is.null(colnames(d))) {
colnames(d.new)[seq(2,ncol(d)+1)] <- colnames(d)[seq(1,ncol(d))]
colnames(d.new)[1] <- ""
}
return(d.new)
}
.order.data.frame <-
function(d, order, summary=FALSE) {
if ((.format.rownames == TRUE) && (summary == FALSE)) { # if we want to report rownames, add them to data frame
if (!is.null(rownames(d))) { d <- .insert.col.front(d, rownames(d)) }
}
# order according to user's wishes
old.order <- 1:length(colnames(d))
new.order <- NULL; add.these <- NULL
if (!is.null(order)) {
# if order is regular expression...
if (is.character(order)) {
not.ordered.yet <- colnames(d)
for (i in 1:length(order)) {
add.these <- grep(order[i], d, perl=.format.perl, fixed=FALSE)
not.ordered.yet[add.these] <- NA
if (length(add.these) != 0) {
new.order <- c(new.order, add.these)
}
}
}
else if (is.numeric(order)) { # if order contains indices
order <- unique(order)
order <- order[order <= max(old.order)]
new.order <- old.order[order]
}
}
if (!is.null(new.order)) {
remainder <- old.order[-new.order]
new.order <- c(new.order, remainder)
}
else { new.order <- old.order }
return( d[new.order] )
}
.print.additional.lines <-
function(part.number=NULL) {
# if no additional lines, then quit the function
if (is.null(.format.add.lines)) { return(NULL) }
max.l <- length(.global.models)+1
for (line in 1:length(.format.add.lines)) {
## add columns if too few, remove if too many
if (max.l > length(.format.add.lines[[line]])) {
.format.add.lines[[line]] <- c(.format.add.lines[[line]], rep(NA, times=max.l - length(.format.add.lines[[line]])))
}
else if (max.l < length(.format.add.lines[[line]])) {
.format.add.lines[[line]] <- .format.add.lines[[line]][1:max.l]
}
.format.add.lines[[line]] <- .format.add.lines[[line]]
## print each line
for (i in 1:max.l) {
if (!is.na(.format.add.lines[[line]][i])) {
if (i==1) {
cat(.format.add.lines[[line]][i], sep="")
}
else {
cat(" & ",.format.add.lines[[line]][i], sep="")
}
}
else {
if (i==1) {
cat(" ", sep="")
}
else {
cat(" & ", sep="")
}
}
}
cat(" \\\\ \n")
}
.table.part.published[part.number] <<- TRUE
}
.print.table.statistic <-
function(.global.var.name, .format.var.name, decimal.digits=.format.round.digits, part.string="", part.number=NULL, type.se=FALSE) {
# default values
report.df <- FALSE
report.p.value <- FALSE
significance.stars <- FALSE
report.se <- FALSE
report.tstat <- FALSE
intelligent.df <- .format.intelligent.df
force.math <- FALSE
# reporting of df, p-value, significance stars, standard errors, t-stats
if (length(grep("(df)", part.string,fixed=TRUE))!=0) { report.df <- TRUE }
if (length(grep("(se)", part.string,fixed=TRUE))!=0) { report.se <- TRUE }
if (length(grep("(t)", part.string,fixed=TRUE))!=0) { report.tstat <- TRUE }
if (length(grep("(p)", part.string,fixed=TRUE))!=0) { report.p.value <- TRUE }
if (length(grep("*", part.string,fixed=TRUE))!=0) { significance.stars <- TRUE }
# first for vectors (statistics without, say, degrees of freedom)
if (is.vector(.global.var.name) == TRUE) {
if (sum(!is.na(.global.var.name))!=0) {
cat (.format.var.name)
for (i in seq(1:length(.global.models))) {
if (!is.na(.global.var.name[i])) {
if (.format.dec.mark.align == TRUE) {
cat(" & \\multicolumn{1}{c}{",.iround(.global.var.name[i], decimal.digits),"}", sep="")
}
else {
cat(" & ",.iround(.global.var.name[i], decimal.digits), sep="")
}
}
else { cat(" & ", sep="") }
}
cat(" \\\\ \n")
.table.part.published[part.number] <<- TRUE
}
}
else if ((is.matrix(.global.var.name) == TRUE) && (type.se == FALSE)) { # for statistics that have degrees of freedom
if (sum(!is.na(as.vector(.global.var.name["statistic",])))!=0) {
# intelligent df reporting (figure out whether only report it on left side, or also)
report.df.left.column <- FALSE
# whittle down unique values
df.all.together <- NULL
for (i in seq(1:length(.global.models))) {
df.string <- ""
for (j in seq(1:(nrow(.global.var.name)- 2))) {
df.string <- paste(df.string,";",as.character(.global.var.name[paste("df",as.character(j),sep=""),i]),sep="")
}
df.all.together <- append(df.all.together, df.string)
}
# remove.na.r
df.all.together.no.NA <- NULL
for (i in seq(1:length(df.all.together))) {
if (substr(df.all.together[i],1,3)!=";NA") { df.all.together.no.NA <- c(df.all.together.no.NA, df.all.together[i]) }
}
df.all.together.no.NA.unique <- sort(unique(df.all.together.no.NA))
# put df on the left if only one unique df in the table, and not just one column w/ given df
if (intelligent.df == TRUE) {
if ((length(df.all.together.no.NA.unique)==1) && (length(df.all.together.no.NA)>=2)) { report.df.left.column <- TRUE }
}
# write down the line
cat (.format.var.name)
# report df on left side w/ intelligent reporting
if (report.df.left.column == TRUE) {
if (report.df == TRUE) {
cat(" ",.format.df.left,sep="")
df.list <- unlist(strsplit(df.all.together.no.NA.unique[1],";"))
for (i in seq(from=2, to=length(df.list))) {
if (i>=3) { cat(.format.df.separator) }
cat(df.list[i],sep="")
}
cat(.format.df.right,sep="")
}
}
# now, go column by column
for (i in seq(1:length(.global.models))) {
if (!is.na(.global.var.name["statistic",i])) {
if (.format.dec.mark.align==TRUE) {
cat(" & \\multicolumn{1}{c}{",.iround(.global.var.name["statistic",i], decimal.digits), sep="")
force.math <- TRUE
}
else {
cat(" & ",.iround(.global.var.name["statistic",i], decimal.digits), sep="")
}
# significance stars
if ((significance.stars == TRUE) && (!is.na(.global.var.name["p-value",i]))) { .enter.significance.stars(.global.var.name["p-value",i], force.math) }
# degrees of freedom - only report by statistics if not in the left column already
if (report.df.left.column == FALSE) {
if ((report.df == TRUE) && (!is.na(.global.var.name["df1",i]))) {
cat(" ",.format.df.left,sep="")
for (j in seq(1:(nrow(.global.var.name)- 2))) {
if (!is.na(.global.var.name[paste("df",as.character(j),sep=""),i])) {
if (j>=2) { cat(.format.df.separator) }
cat(.global.var.name[paste("df",as.character(j),sep=""),i],sep="")
}
}
cat(.format.df.right,sep="")
}
}
# p-values
if ((report.p.value == TRUE) && (!is.na(.global.var.name["p-value",i]))) {
cat(" ",.format.p.value.left,sep="")
if (!is.na(.global.var.name[paste("df",as.character(j),sep=""),i])) {
cat(.iround(.global.var.name["p-value",i],.format.round.digits, round.up.positive=TRUE),sep="")
}
cat(.format.p.value.right,sep="")
}
if (.format.dec.mark.align==TRUE) {
cat("}")
}
else {
cat("")
}
}
else { cat(" & ", sep="") }
}
cat(" \\\\ \n")
.table.part.published[part.number] <<- TRUE
}
}
else if ((is.matrix(.global.var.name) == TRUE) && (type.se == TRUE)) { # for statistics that have a standard error
if (sum(!is.na(as.vector(.global.var.name["statistic",])))!=0) {
# write down the line
cat (.format.var.name)
# now, go column by column
for (i in seq(1:length(.global.models))) {
if (!is.na(.global.var.name["statistic",i])) {
if (.format.dec.mark.align == TRUE) {
cat(" & \\multicolumn{1}{c}{",.iround(.global.var.name["statistic",i], decimal.digits), sep="")
}
else {
cat(" & ",.iround(.global.var.name["statistic",i], decimal.digits), sep="")
}
# significance stars
if ((significance.stars == TRUE) && (!is.na(.global.var.name["p-value",i]))) { .enter.significance.stars(.global.var.name["p-value",i], force.math) }
# standard errors
if ((report.se == TRUE) && (!is.na(.global.var.name["se",i]))) { cat(" ",.format.se.left,.iround(.global.var.name["se",i], decimal.digits),.format.se.right,sep="") }
# t-statistics
if ((report.tstat == TRUE) && (!is.na(.global.var.name["tstat",i]))) { cat(" ",.format.tstat.left, .iround(.global.var.name["tstat",i], decimal.digits),.format.tstat.right,sep="") }
# p-values
if ((report.p.value == TRUE) && (!is.na(.global.var.name["p-value",i]))) { cat(" ",.format.p.value.left,.iround(.global.var.name["p-value",i], decimal.digits),.format.p.value.right,sep="") }
if (.format.dec.mark.align == TRUE) {
cat("}")
}
else {
cat("")
}
}
else { cat(" & ", sep="") }
}
cat(" \\\\ \n")
.table.part.published[part.number] <<- TRUE
}
}
}
.publish.table <-
function() {
.table.info.comment()
# table header
.table.header()
.table.insert.space()
.table.part.published <<- as.vector(rep(NA, times=length(.format.table.parts))) # to keep track what has been published (to deal intelligently with horizontal lines)
.publish.horizontal.line <<- TRUE # should non-compulsory horizontal lines be published? (yes, if something else published since the previous line)
if (length(.format.table.parts)>=1) {
for (i in seq(1:length(.format.table.parts))) {
.publish.table.part(part=.format.table.parts[i], which.part.number=i)
if (.table.part.published[i]==TRUE) { .publish.horizontal.line <<- TRUE }
if ((.format.table.parts[i]=="-") || (.format.table.parts[i]=="-!") || (.format.table.parts[i]=="=") || (.format.table.parts[i]=="=!")) { .publish.horizontal.line <<- FALSE }
}
}
cat("\\end{tabular} \n")
if (.format.floating == TRUE) { cat("\\end{", .format.floating.environment,"} \n", sep="") }
else if (!is.null(.format.font.size)) {
cat("\\endgroup \n",sep="")
}
}
.publish.table.part <-
function(part, which.part.number) {
.table.part.published[which.part.number] <<- FALSE
# dependent variable label line
if (part=="dependent variable label") {
if (.format.dependent.variable.text.on == TRUE) {
cat(" & \\multicolumn{",length(.global.models),"}{c}{",.format.dependent.variable.text, "} \\\\ \n", sep="")
if (.format.dependent.variable.text.underline == TRUE) { cat("\\cline{2-",length(.global.models)+1,"} \n", sep="") }
}
.table.part.published[which.part.number] <<- TRUE
}
# dependent variables
else if (part=="dependent variables") {
.table.insert.space()
cat(.format.dependent.variables.text)
how.many.columns <- 0
label.counter <- 0
for (i in seq(1:length(.global.models))) {
if (is.null(.format.dep.var.labels)) { .format.dep.var.labels <<- NA }
how.many.columns <- how.many.columns + 1
# write down if next column has different dependent variable, or if end of columns
different.dependent.variable <- FALSE
if (i == length(.global.models)) {different.dependent.variable <- TRUE}
else if ((as.character(.global.dependent.variables[i])) != (as.character(.global.dependent.variables[i+1]))) {different.dependent.variable <- TRUE}
if (.format.multicolumn==FALSE) { different.dependent.variable <- TRUE }
if (different.dependent.variable == TRUE) {
label.counter <- label.counter + 1
if (how.many.columns == 1) {
if (.format.dec.mark.align==TRUE) {
if (is.na(.format.dep.var.labels[label.counter])) {
if (.format.dependent.variables.capitalize == TRUE) { cat(" & \\multicolumn{1}{c}{",.format.dependent.variables.left,toupper(as.character(.global.dependent.variables.written[i])),.format.dependent.variables.right,"}", sep="") }
else { cat(" & \\multicolumn{1}{c}{",.format.dependent.variables.left,as.character(.global.dependent.variables.written[i]),.format.dependent.variables.right,"}", sep="") }
}
else { cat(" & \\multicolumn{1}{c}{",.format.dependent.variables.left,.format.dep.var.labels[label.counter],.format.dependent.variables.right,"}", sep="") }
}
else {
if (is.na(.format.dep.var.labels[label.counter])) {
if (.format.dependent.variables.capitalize == TRUE) { cat(" & ",.format.dependent.variables.left,toupper(as.character(.global.dependent.variables.written[i])),.format.dependent.variables.right, sep="") }
else { cat(" & ",.format.dependent.variables.left,as.character(.global.dependent.variables.written[i]),.format.dependent.variables.right, sep="") }
}
else { cat(" & ",.format.dependent.variables.left,.format.dep.var.labels[label.counter],.format.dependent.variables.right, sep="") }
}
}
else {
if (is.na(.format.dep.var.labels[label.counter])) {
if (.format.dependent.variables.capitalize == TRUE) {cat(" & \\multicolumn{",how.many.columns,"}{c}{",.format.dependent.variables.left,toupper(as.character(.global.dependent.variables.written[i])),.format.dependent.variables.right,"}", sep="")}
else {cat(" & \\multicolumn{",how.many.columns,"}{c}{",.format.dependent.variables.left,as.character(.global.dependent.variables.written[i]),.format.dependent.variables.right,"}", sep="")}
}
else {cat(" & \\multicolumn{",how.many.columns,"}{c}{",.format.dependent.variables.left,.format.dep.var.labels[label.counter],.format.dependent.variables.right,"}", sep="")}
}
how.many.columns <- 0
}
}
cat(" \\\\ \n")
.table.part.published[which.part.number] <<- TRUE
}
# models
else if (part=="models") {
if ((.format.model.names.include==TRUE) && ((.format.models.skip.if.one == FALSE) || ((.format.models.skip.if.one == TRUE) && (length(unique(.global.models))>=2)))) {
.table.insert.space()
cat(.format.models.text)
# rename models based on .formatting preferences
renamed.global.models <- as.matrix(rbind(.global.models, rep("", times=