R/regTex.R

In walshc/regTex: regTex

regTex <- function(regs, vars, file = NULL, depvars = NULL, vcov = NULL,
                   intercept = FALSE, fixed.effects = NULL,
                   number.format = "%.2f", stars = c(0.1, 0.05, 0.01),
                   parentheses = "se",  stats = c("N"), table.env = FALSE,
                   caption = " ", caption.position = "bottom",
                   stand.alone = FALSE, compile = FALSE)  {

  if (any(class(regs) != "list")) {
    regs <- list(regs)
  }

  # Check that vars was inputted correctly:
  if (!is.list(vars)) {
    stop("'vars' must be a list")
  } else {
    # If only one row is provided, add the second row:
    vars <- lapply(vars, function(x) {
      if (length(x) == 1) {
        return(c(x, ""))
      } else if (length(x) == 2) {
        return(x)
      } else {
        return(x[1:2])
      }
    })
  }

  # If depvars is provided, check that it was inputed correctly.
  depvar.names <- unlist(lapply(regs, function(x) names(x$model)[1]))
  if (is.null(depvars)) {
    if (length(unique(depvar.names)) > 1) {
      stop("If dependent variables differ between models, 'depvars' must be
           provided")
    }
  } else {
    if (length(unique(depvar.names)) > 1) {
      if (!is.list(depvars)) {
        stop("'depvars' must be a list")
      }
      if (length(depvars) != length(regs)) {
        stop("Number of names in 'depvars' does not match the length of
             'regs'")
      }
    }
    if (is.list(depvars)) {
      # Make each element of depvars have the same number of elements:
      num.depvar.rows <-
        length(depvars[[which.max(lapply(depvars, length))]])
      depvars <- lapply(depvars, function(x) {
        for (i in 1:num.depvar.rows) {
          if (length(x) == i) {
            return(c(rep("", num.depvar.rows - i), x))
          }
        }
      })
    }
  }

  # Check that vcov was inputted correctly, if not given use the defaults:
  if (!is.null(vcov)) {
    if (!is.list(vcov) | any(unlist(lapply(vcov, class)) != "matrix")) {
      stop("Argument 'vcov' must be a list of matrices")
    }
  } else {
    vcov <- lapply(regs, vcov)
  }

  # Check that intercept was inputted correctly:
  if (!is.logical(intercept)) {
    stop("Argument 'intercept' must be logical (TRUE or FALSE)")
  }
  if (!is.null(fixed.effects)) {
    if (!is.list(fixed.effects)) {
      stop("'fixed.effects' must be a list")
    } else if (any(unlist(lapply(fixed.effects, length)) != length(regs)+1)) {
      stop("Each element of 'fixed.effects' must have a length equal to the
           number of regressions plus one (for the title)")
    }
  }

  if (!(caption.position %in% c("top", "bottom"))) {
    stop("'caption.position' can only be 'top' or 'bottom'")
  }

  if (!is.null(file)) {
    sink(file)
  }
  if (stand.alone | compile) {
    cat("\\documentclass[12pt]{article}\n")
    cat("\\usepackage{siunitx}\n")
    cat("\\begin{document}\n")
  }
  if (table.env) {
    cat("\\begin{table}")
    if (caption.position == "top") {
      cat("\\caption{")
      cat(caption)
      cat("}\n")
    }
  }
  cat("\\begin{tabular}{l*{")
  cat(length(regs))
  cat("}{S[input-symbols         = (),
           table-align-text-pre  = false,
           table-align-text-post = false]}}\n")
  # If depvars is provided, display dependent variable name above the column:
  cat("\\hline \\hline\n")
  if (!is.null(depvars)) {
    if (!is.list(depvars)) {
      cat("Dependent variable:")
      cat(rep("&", length(regs)))
      cat("\\\\\n")
      cat(depvars)
    } else {
      for (i in 1:num.depvar.rows) {
        for (j in 1:length(depvars)) {
          cat(" & {")
          cat(depvars[[j]][i])
          cat("} ")
        }
      cat("\\\\\n")
      }
    }
  }
  # Display model number in parentheses if more than one regression:
  if (length(regs) > 1) {
    for (i in seq_along(regs)) {
      cat(" & ")
      cat("({")
      cat(i)
      cat("})")
    }
  }
  cat("\\\\ \\hline\n")
  cat("\\rule{0pt}{3ex}")
  if (intercept) {
    cat("Constant")
    for (j in seq_along(regs)) {
      t.stat <- regs[[j]]$coefficients[1]/sqrt(vcov[[j]][1, 1])
      tmp <- pt(t.stat, df = regs[[j]]$df.residual)
      p.value <- 2*(1 - tmp)
      cat(" & ")
      cat(sprintf(number.format, regs[[j]]$coefficients[1]))
      if (!is.null(stars)) {
        if (p.value <= stars[3]) {
          cat("$^{\\star\\star\\star}$")
        } else if (p.value <= stars[2] & p.value > stars[3]) {
          cat("$^{\\star\\star}$")
        } else if (p.value <= stars[1] & p.value > stars[2]) {
          cat("$^{\\star}$")
        }
      }
    }
    cat("\\\\\n")
    for (j in seq_along(regs)) {
      cat(" & ")
      cat("{(}")
      if (parentheses == "se") {
        cat(sprintf(number.format, sqrt(vcov[[j]][1, 1])))
      } else if (parentheses == "t") {
        cat(sprintf(number.format, t.stat))
      } else if (parentheses == "p") {
        cat(sprintf(number.format, p.value))
      } else {
        stop("'parentheses' must be one of 'se', 't', 'p'")
      }
      cat("{)}")
    }
    cat("\\\\\n")
    cat("\\rule{0pt}{3ex}")
  }
  for (i in seq_along(vars)) {
    cat(vars[[i]][1])
    for (j in seq_along(regs)) {
      if (any(class(regs[[j]]) == "felm")) {
        coef.names <- rownames(regs[[j]]$coefficients)
      } else {
        coef.names <- names(regs[[j]]$coefficients)
      }
      # Check if the variable was included in the regression:
      cat(" & ")
      if (names(vars)[i] %in% coef.names) {
        k <- which(coef.names == names(vars)[i])
        cat(sprintf(number.format, regs[[j]]$coefficients[k]))
        # Significance stars (from the Student t distribution):
        t.stat <-  abs(regs[[j]]$coefficients[k]/sqrt(vcov[[j]][k, k]))
        tmp <- pt(t.stat, df = regs[[j]]$df.residual)
        p.value <- 2*(1 - tmp)
        if (!is.null(stars)) {
          if (p.value <= stars[3]) {
            cat("$^{\\star\\star\\star}$")
          } else if (p.value <= stars[2] & p.value > stars[3]) {
            cat("$^{\\star\\star}$")
          } else if (p.value <= stars[1] & p.value > stars[2]) {
            cat("$^{\\star}$")
          }
        }
      }
    }
    cat("\\\\\n")
    if (!is.na(vars[[i]][2])) {
      cat(vars[[i]][2])
    }
    for (j in seq_along(regs)) {
      if (any(class(regs[[j]]) == "felm")) {
        coef.names <- rownames(regs[[j]]$coefficients)
      } else {
        coef.names <- names(regs[[j]]$coefficients)
      }
      cat(" & ")
      if (names(vars)[i] %in% coef.names) {
        k <- which(coef.names == names(vars)[i])
        cat("{(}")
        if (parentheses == "se") {
          cat(sprintf(number.format, sqrt(vcov[[j]][k, k])))
        } else if (parentheses == "t") {
          t.stat <-  abs(regs[[j]]$coefficients[k]/sqrt(vcov[[j]][k, k]))
          cat(sprintf(number.format, t.stat))
        } else if (parentheses == "p") {
          t.stat <-  abs(regs[[j]]$coefficients[k]/sqrt(vcov[[j]][k, k]))
          tmp <- pt(t.stat, df = regs[[j]]$df.residual)
          p.value <- 2*(1 - tmp)
          cat(sprintf(number.format, p.value))
        } else {
          stop("'parentheses' must be one of 'se', 't', 'p'")
        }
        cat("{)}")
      }
    }
    cat("\\\\\n")
  }
  if (!is.null(fixed.effects)) {
    cat(rep("&", length(regs)))
    cat("\\\\\n")
    for (i in seq_along(fixed.effects)) {
      cat(fixed.effects[[i]][1])
      for (j in seq_along(regs)) {
        cat("& {")
        cat(fixed.effects[[i]][j + 1])
        cat("}")
      }
      cat("\\\\\n")
    }
  }
  cat("\\hline\\rule{0pt}{3ex}")
  for (i in seq_along(stats)) {
    if (stats[i] == "N") {
      cat("$N$")
      for (j in seq_along(regs)) {
        cat(" & {")
        cat(length(regs[[j]]$residuals))
        cat("} ")
      }
      cat("\\\\\n")
    }
    if (stats[i] == "R.squared") {
      cat("$R^2$")
      for (j in seq_along(regs)) {
        cat(" &")
        if (any(class(regs[[j]]) == "lm")) {
          cat(sprintf(number.format, summary(regs[[j]])$r.squared))
        } else if (any(class(regs[[j]]) == "felm")) {
          cat(sprintf(number.format, summary(regs[[j]])$r2))
        }
        cat("")
      }
      cat("\\\\\n")
    }
    if (stats[i] == "adj.R.squared") {
      cat("Adjusted $R^2$")
      for (j in seq_along(regs)) {
        cat(" &")
        if (any(class(regs[[j]]) == "lm")) {
          R.sq <- summary(regs[[j]])$r.squared
          adj.R.squared <- 1 - (1 - R.sq) *
                           ((nrow(regs[[j]]$model) - 1)/regs[[j]]$df.residual)
        cat(sprintf(number.format, adj.R.squared))
        } else if (any(class(regs[[j]]) == "felm")) {
          cat(sprintf(number.format, summary(regs[[j]])$r2adj))
        }
        cat("")
      }
      cat("\\\\\n")
    }
    if (stats[i] == "F") {
      cat("$F$-statistic")
      for (j in seq_along(regs)) {
        cat(" &")
        if (any(class(regs[[j]]) == "lm")) {
          cat(sprintf(number.format, summary(regs[[j]])$fstatistic[1]))
        } else if (any(class(regs[[j]]) == "felm")) {
          cat(sprintf(number.format, summary(regs[[j]])$fstat))
        }
        cat("")
      }
      cat("\\\\\n")
    }
    if (stats[i] == "mean.depvar") {
      cat("Mean dependent variable")
      for (j in seq_along(regs)) {
        if (any("felm" %in% class(regs[[i]]))) {
          cat(" &")
          cat(sprintf(number.format, mean(regs[[j]]$response)))
          cat("")
        } else {
          cat(" &")
          cat(sprintf(number.format, mean(regs[[j]]$model[[1]])))
          cat("")
        }
      }
      cat("\\\\\n")
    }
  }
  cat("\\hline \\hline\n\\end{tabular}\n")
  if (table.env) {
    if (caption.position == "bottom") {
      cat("\\caption{")
      cat(caption)
      cat("}\n")
    }
    cat("\\end{table}")
  }
  if (stand.alone | compile) {
    cat("\\end{document}")
  }
  if (!is.null(file)) {
    sink()
  }
  if (!is.null(file) & compile) {
    system(paste("pdflatex", file))
  }
}