follow up: using texreg with systemfit

 

I improved the code from the last post. This now also works with with systemfit objects with multiple regressions.

 

#adjusted to allow regression results from the systemfit package to be printed
#use as mytexreg(systemfitobject , ...)  the syntax is identical to texreg
#author: johannes.kutsam@gmail.com july 29th, 2012
#license: public domain

library(texreg)
mytexreg=texreg # make a copy of the original
body(mytexreg)=body(texreg2) #replace the function body

generic=setClass("generic",
                 representation(tab="matrix",gof="matrix"),
                 prototype=list(tab=matrix(0,0,0),gof=matrix(0,0,0)))

 

systemfit2texreg=function(s){
  eqlist=list()
  for(eq in s$eq){
    sum=summary(eq)
    tab=coef(sum)
    tab=tab[,-3] # remove t values
    r=sum$r.squared
    radj=sum$adj.r.squared
    n=nobs(s)
    gof=matrix(c(r,radj,n),ncol=1)
    row.names(gof)=c("R$^2$","Adj. R$^2$","Num. obs.")
    mygen=generic(tab=tab,gof=gof)
    eqlist[[eq$eqnNo]]=mygen
  }
  eqlist
}

extract.generic=function(model){
  if(!class(model)=="generic"){
    stop("Internal error: Incorrect model type! Should be a systemfit object")
  }
  list(tab=model@tab,gof=model@gof)
}

texreg2=function (l, single.row = FALSE, no.margin = TRUE, leading.zero = TRUE,
          table = TRUE, sideways = FALSE, float.pos = "", strong.signif = FALSE,
          symbol = "\\cdot", use.packages = TRUE, caption = "Statistical models",
          label = "table:coefficients", dcolumn = TRUE, booktabs = TRUE,
          scriptsize = FALSE, custom.names = NA, model.names = NA)
{
  string <- ""
  if (class(l)[1] == "ergm" | class(l)[1] == "lme" | class(l)[1] ==
    "lm" | class(l)[1] == "gls" | class(l)[1] == "glm" | class(l)[1]=="generic") {
    l <- list(l)
  }
  else if (class(l) != "list") {
    stop("Unknown object was handed over.")
  }
  models <- NULL
  for (i in 1:length(l)) {
    if (class(l[[i]])[1] == "ergm") {
      model <- extract.ergm(l[[i]])
      models <- append(models, list(model))
    }
    else if (class(l[[i]])[1] == "lme") {
      model <- extract.lme(l[[i]])
      models <- append(models, list(model))
    }
    else if (class(l[[i]])[1] == "lm") {
      model <- extract.lm(l[[i]])
      models <- append(models, list(model))
    }
    else if (class(l[[i]])[1] == "gls") {
      model <- extract.gls(l[[i]])
      models <- append(models, list(model))
    }
    else if (class(l[[i]])[1] == "glm") {
      model <- extract.glm(l[[i]])
      models <- append(models, list(model))
    }
    else if (class(l[[i]])[1] == "generic") {
      model <- extract.generic(l[[i]])
      models <- append(models, list(model))
    }
    else {
      warning(paste("Skipping unknown model of type ",
                    class(l[[i]]), ".", sep = ""))
    }
  }
  gof.names <- character()
  for (i in 1:length(models)) {
    for (j in 1:length(models[[i]][[2]])) {
      if (!row.names(models[[i]][[2]])[j] %in% gof.names) {
        gof.names <- append(gof.names, row.names(models[[i]][[2]])[j])
      }
    }
  }
  coefs <- list()
  gofs <- matrix(nrow = length(gof.names), ncol = length(models))
  row.names(gofs) <- gof.names
  for (i in 1:length(models)) {
    coefs <- append(coefs, models[[i]][1])
    for (j in 1:length(models[[i]][[2]])) {
      rn <- row.names(models[[i]][[2]])[j]
      val <- models[[i]][[2]][j]
      col <- i
      row <- which(row.names(gofs) == rn)
      gofs[row, col] <- val
    }
  }
  coef.order <- character()
  for (i in 1:length(coefs)) {
    for (j in 1:length(rownames(coefs[[i]]))) {
      if (!rownames(coefs[[i]])[j] %in% coef.order) {
        coef.order <- append(coef.order, rownames(coefs[[i]])[j])
      }
    }
  }
  if (length(coefs) == 1) {
    m <- coefs[[1]]
  }
  else if (length(coefs) > 1) {
    m <- coefs[[1]]
    for (i in 2:length(coefs)) {
      m <- merge(m, coefs[[i]], by = 0, all = TRUE)
      rownames(m) <- m[, 1]
      m <- m[, colnames(m) != "Row.names"]
      colnames(m) <- NULL
    }
  }
  colnames(m) <- rep(colnames(coefs[[1]]), length(coefs))
  m.temp <- matrix(nrow = nrow(m), ncol = ncol(m))
  for (i in 1:nrow(m)) {
    new.row <- which(coef.order == rownames(m)[i])
    for (j in 1:length(m[i, ])) {
      m.temp[new.row, j] <- m[i, j]
    }
  }
  rownames(m.temp) <- coef.order
  colnames(m.temp) <- colnames(m)
  m <- m.temp
  if (length(custom.names) > 1) {
    if (!class(custom.names) == "character") {
      stop("Custom coefficient names must be provided as a vector of strings!")
    }
    else if (length(custom.names) != length(rownames(m))) {
      stop(paste("There are", length(rownames(m)), "coefficients, but you provided",
                 length(custom.names), "custom names for them."))
    }
    else {
      rownames(m) <- custom.names
    }
  }
  else if (!is.na(custom.names) & class(custom.names) != "character") {
    stop("Custom coefficient names must be provided as a vector of strings.")
  }
  else if (length(custom.names) == 1 & class(custom.names) ==
    "character") {
    rownames(m) <- custom.names
  }
  for (i in 1:length(rownames(m))) {
    for (j in 1:length(rownames(m))) {
      if (i != j & rownames(m)[i] == rownames(m)[j]) {
        identical <- logical(length(m[i, ]))
        for (k in 1:length(m[i, ])) {
          if ((is.na(m[i, k]) & !is.na(m[j, k])) | (!is.na(m[i,
                                                             k]) & is.na(m[j, k])) | (is.na(m[i, k]) &
                                                               is.na(m[j, k]))) {
            identical[k] <- TRUE
          }
        }
        if (length(identical[identical == FALSE]) ==
          0) {
          for (k in 1:ncol(m)) {
            if (is.na(m[i, k])) {
              m[i, k] <- m[j, k]
            }
            else if (is.na(m[j, k])) {
              m[j, k] <- m[i, k]
            }
          }
        }
      }
    }
  }
  m <- m[duplicated(m) == FALSE, ]
  m <- as.data.frame(m)
  lab.list <- c(rownames(m), gof.names)
  lab.length <- 0
  for (i in 1:length(lab.list)) {
    if (nchar(lab.list[i]) > lab.length) {
      lab.length <- nchar(lab.list[i])
    }
  }
  string <- paste(string, "\n", sep = "")
  if (use.packages == TRUE) {
    if (sideways == TRUE & table == TRUE) {
      string <- paste(string, "\\usepackage{rotating}\n",
                      sep = "")
    }
    if (booktabs == TRUE) {
      string <- paste(string, "\\usepackage{booktabs}\n",
                      sep = "")
    }
    if (dcolumn == TRUE) {
      string <- paste(string, "\\usepackage{dcolumn}\n\n",
                      sep = "")
    }
  }
  if (table == TRUE) {
    if (sideways == TRUE) {
      t <- "sideways"
    }
    else {
      t <- ""
    }
    if (float.pos == "") {
      string <- paste(string, "\\begin{", t, "table}\n",
                      sep = "")
    }
    else {
      string <- paste(string, "\\begin{", t, "table}[",
                      float.pos, "]\n", sep = "")
    }
    string <- paste(string, "\\begin{center}\n", sep = "")
    if (scriptsize == TRUE) {
      string <- paste(string, "\\scriptsize\n", sep = "")
    }
  }
  string <- paste(string, "\\begin{tabular}{l ", sep = "")
  for (i in 1:length(models)) {
    gof.list <- as.vector(gofs[, i])
    gof.list.string <- NULL
    for (j in 1:length(gof.list)) {
      gof.list.string[j] <- coef.to.string(gof.list[j],
                                           leading.zero)
    }
    if (dcolumn == TRUE) {
      dec.left <- max(c(nchar(gof.list.string) - 3), 3)
      if (single.row == TRUE) {
        dec.right <- 3
        separator <- ")"
        dec.left <- 11
      }
      else {
        dec.right <- 5
        separator <- "."
      }
      if (no.margin == FALSE) {
        margin.arg <- ""
      }
      else {
        margin.arg <- "@{}"
      }
      string <- paste(string, "D{", separator, "}{", separator,
                      "}{", dec.left, separator, dec.right, "} ", margin.arg,
                      sep = "")
    }
    else {
      string <- paste(string, "c ", sep = "")
    }
  }
  if (booktabs == TRUE) {
    string <- paste(string, "}\n", "\\toprule\n", sep = "")
  }
  else {
    string <- paste(string, "}\n", "\\hline\n", sep = "")
  }
  for (k in 1:lab.length) {
    string <- paste(string, " ", sep = "")
  }
  if (length(model.names) > 1) {
    if (class(model.names) != "character") {
      stop("Model names must be specified as a vector of strings.")
    }
    else if (length(model.names) != length(l)) {
      stop(paste("There are", length(l), "models, but you provided",
                 length(model.names), "names for them."))
    }
    else {
      if (dcolumn == TRUE) {
        for (i in 1:length(l)) {
          string <- paste(string, " & \\multicolumn{1}{c}{",
                          model.names[i], "}", sep = "")
        }
      }
      else {
        for (i in 1:length(l)) {
          string <- paste(string, " & ", model.names[i],
                          sep = "")
        }
      }
    }
  }
  else if (!is.na(model.names) & class(model.names) != "character") {
    stop("Model names must be specified as a vector of strings.")
  }
  else if (class(model.names) == "character" & length(model.names) !=
    length(l)) {
    stop(paste("A single model name was specified. But there are in fact",
               length(l), "models."))
  }
  else if (class(model.names) == "character") {
    if (dcolumn == TRUE) {
      string <- paste(string, " & \\multicolumn{1}{c}{",
                      model.names, "}", sep = "")
    }
    else {
      string <- paste(string, " & ", model.names, sep = "")
    }
  }
  else {
    if (dcolumn == TRUE) {
      for (i in 1:length(l)) {
        string <- paste(string, " & \\multicolumn{1}{c}{Model ",
                        i, "}", sep = "")
      }
    }
    else {
      for (i in 1:length(l)) {
        string <- paste(string, " & Model ", i, sep = "")
      }
    }
  }
  if (booktabs == TRUE) {
    string <- paste(string, " \\\\\n", "\\midrule\n", sep = "")
  }
  else {
    string <- paste(string, " \\\\\n", "\\hline\n", sep = "")
  }
  if (single.row == TRUE) {
    output.matrix <- matrix(ncol = (length(m)/3) + 1, nrow = length(m[,
                                                                      1]))
    for (i in 1:length(rownames(m))) {
      output.matrix[i, 1] <- rownames(m)[i]
    }
    for (i in 1:length(m[, 1])) {
      j <- 1
      k <- 2
      while (j <= length(m)) {
        if (is.na(m[i, j])) {
          output.matrix[i, k] <- ""
        }
        else if (m[i, j] == -Inf) {
          output.matrix[i, k] <- "-Inf (NA)"
        }
        else {
          std <- paste(" \\; (", coef.to.string(m[i,
                                                  j + 1], leading.zero), ")", sep = "")
          if (strong.signif == TRUE) {
            if (m[i, j + 2] <= 0.001) {
              p <- "^{***}"
            }
            else if (m[i, j + 2] <= 0.01) {
              p <- "^{**}"
            }
            else if (m[i, j + 2] <= 0.05) {
              p <- "^{*}"
            }
            else if (m[i, j + 2] <= 0.1) {
              p <- paste("^{", symbol, "}", sep = "")
            }
            else {
              p <- ""
            }
          }
          else {
            if (m[i, j + 2] <= 0.01) {
              p <- "^{***}"
            }
            else if (m[i, j + 2] <= 0.05) {
              p <- "^{**}"
            }
            else if (m[i, j + 2] <= 0.1) {
              p <- "^{*}"
            }
            else {
              p <- ""
            }
          }
          if (dcolumn == TRUE) {
            dollar <- ""
          }
          else {
            dollar <- "$"
          }
          entry <- paste(dollar, coef.to.string(m[i,
                                                  j], leading.zero), std, p, dollar, sep = "")
          output.matrix[i, k] <- entry
        }
        k <- k + 1
        j <- j + 3
      }
    }
  }
  else {
    output.matrix <- matrix(ncol = (length(m)/3) + 1, nrow = 2 *
      length(m[, 1]))
    for (i in 1:length(rownames(m))) {
      output.matrix[(i * 2) - 1, 1] <- rownames(m)[i]
      output.matrix[(i * 2), 1] <- ""
    }
    for (i in 1:length(m[, 1])) {
      j <- 1
      k <- 2
      while (j <= length(m)) {
        if (is.na(m[i, j])) {
          output.matrix[(i * 2) - 1, k] <- ""
          output.matrix[(i * 2), k] <- ""
        }
        else if (m[i, j] == -Inf) {
          output.matrix[(i * 2) - 1, k] <- "-Inf"
          output.matrix[(i * 2), k] <- "(NA)"
        }
        else {
          if (strong.signif == TRUE) {
            if (m[i, j + 2] <= 0.001) {
              p <- "^{***}"
            }
            else if (m[i, j + 2] <= 0.01) {
              p <- "^{**}"
            }
            else if (m[i, j + 2] <= 0.05) {
              p <- "^{*}"
            }
            else if (m[i, j + 2] <= 0.1) {
              p <- paste("^{", symbol, "}", sep = "")
            }
            else {
              p <- ""
            }
          }
          else {
            if (m[i, j + 2] <= 0.01) {
              p <- "^{***}"
            }
            else if (m[i, j + 2] <= 0.05) {
              p <- "^{**}"
            }
            else if (m[i, j + 2] <= 0.1) {
              p <- "^{*}"
            }
            else {
              p <- ""
            }
          }
          if (dcolumn == TRUE) {
            dollar <- ""
          }
          else {
            dollar <- "$"
          }
          output.matrix[(i * 2) - 1, k] <- paste(dollar,
                                                 coef.to.string(m[i, j], leading.zero), p,
                                                 dollar, sep = "")
          output.matrix[(i * 2), k] <- paste(dollar,
                                             "(", coef.to.string(m[i, j + 1], leading.zero),
                                             ")", dollar, sep = "")
        }
        k <- k + 1
        j <- j + 3
      }
    }
  }
  if (dcolumn == TRUE) {
    dollar <- ""
  }
  else {
    dollar <- "$"
  }
  gof.matrix <- matrix(nrow = nrow(gofs), ncol = ncol(gofs) +
    1)
  for (i in 1:length(gofs[, 1])) {
    gof.matrix[i, 1] <- rownames(gofs)[i]
    for (j in 1:length(gofs[1, ])) {
      strg <- coef.to.string(gofs[i, j], leading.zero)
      rn <- rownames(gofs)[i]
      if (rn == "Num. obs." | rn == "n" | rn == "N" | rn ==
        "N obs" | rn == "N obs." | rn == "nobs" | rn ==
        "n obs" | rn == "n obs." | rn == "n.obs." | rn ==
        "N.obs." | rn == "N. obs" | rn == "Num observations" |
        rn == "Number of observations" | rn == "Num obs" |
        rn == "num obs" | rn == "Num. observations" |
        rn == "Num Observations" | rn == "Num. Observations" |
        rn == "Num. Obs." | rn == "Num.Obs." | rn ==
        "Number obs." | rn == "Number Obs." | rn == "Number obs" |
        rn == "Number Obs" | rn == "Number of Obs." |
        rn == "Number of obs." | rn == "Number of obs" |
        rn == "Number of Obs" | rn == "Obs" | rn == "obs" |
        rn == "Obs." | rn == "obs.") {
        strg <- substring(strg, 1, nchar(strg) - 3)
      }
      gof.matrix[i, j + 1] <- paste(dollar, strg, dollar,
                                    sep = "")
    }
  }
  output.matrix <- rbind(output.matrix, gof.matrix)
  max.lengths <- numeric(length(output.matrix[1, ]))
  for (i in 1:length(output.matrix[1, ])) {
    max.length <- 0
    for (j in 1:length(output.matrix[, 1])) {
      if (nchar(output.matrix[j, i]) > max.length) {
        max.length <- nchar(output.matrix[j, i])
      }
    }
    max.lengths[i] <- max.length
  }
  for (i in 1:length(output.matrix[, 1])) {
    for (j in 1:length(output.matrix[1, ])) {
      nzero <- max.lengths[j] - nchar(output.matrix[i,
                                                    j])
      zeros <- rep(" ", nzero)
      zeros <- paste(zeros, collapse = "")
      output.matrix[i, j] <- paste(output.matrix[i, j],
                                   zeros, sep = "")
    }
  }
  for (i in 1:(length(output.matrix[, 1]) - length(gof.names))) {
    for (j in 1:length(output.matrix[1, ])) {
      string <- paste(string, output.matrix[i, j], sep = "")
      if (j == length(output.matrix[1, ])) {
        string <- paste(string, " \\\\\n", sep = "")
      }
      else {
        string <- paste(string, " & ", sep = "")
      }
    }
  }
  if (booktabs == TRUE) {
    string <- paste(string, "\\midrule\n", sep = "")
  }
  else {
    string <- paste(string, "\\hline\n", sep = "")
  }
  for (i in (length(output.matrix[, 1]) - (length(gof.names) -
    1)):(length(output.matrix[, 1]))) {
    for (j in 1:length(output.matrix[1, ])) {
      string <- paste(string, output.matrix[i, j], sep = "")
      if (j == length(output.matrix[1, ])) {
        string <- paste(string, " \\\\\n", sep = "")
      }
      else {
        string <- paste(string, " & ", sep = "")
      }
    }
  }
  if (booktabs == TRUE) {
    string <- paste(string, "\\bottomrule\n", sep = "")
  }
  else {
    string <- paste(string, "\\hline\n", sep = "")
  }
  string <- paste(string, "\\vspace{-2mm}\\\\\n", sep = "")
  if (strong.signif == TRUE) {
    string <- paste(string, "\\multicolumn{", length(l) +
      1, "}{l}{\\textsuperscript{***}$p<0.001$, ", "\\textsuperscript{**}$p<0.01$, \\textsuperscript{*}$p<0.05$, ",
                    "\\textsuperscript{$", symbol, "$}$p<0.1$}\n", sep = "")
  }
  else {
    string <- paste(string, "\\multicolumn{", length(l) +
      1, "}{l}{\\textsuperscript{***}$p<0.01$, ", "\\textsuperscript{**}$p<0.05$, \\textsuperscript{*}$p<0.1$}\n",
                    sep = "")
  }
  string <- paste(string, "\\end{tabular}\n", sep = "")
  if (table == TRUE) {
    if (scriptsize == TRUE) {
      string <- paste(string, "\\normalsize\n", sep = "")
    }
    string <- paste(string, "\\end{center}\n", sep = "")
    string <- paste(string, "\\caption{", caption, "}\n",
                    sep = "")
    string <- paste(string, "\\label{", label, "}\n", sep = "")
    if (sideways == TRUE) {
      t <- "sideways"
    }
    else {
      t <- ""
    }
    string <- paste(string, "\\end{", t, "table}\n", sep = "")
  }
  cat(string)
  return(string)
}

R and texreg

 

Texreg is a nice library for R to generate TEX from regression results. The support for systemfit objects was missing; I just implemented it:

https://r-forge.r-project.org/forum/forum.php?thread_id=6817&forum_id=4325&group_id=1420

knitr+R+miktex+Lyx+Rstudio = beautiful AND reproducible research

 

I have found the tools I am looking for:

R – to analyze data and create graphics

knitr – (a package for r) to elegantly merge my statistical analysis with my text

miktex – to generate pdfs from my latex files

and Lyx and RStudio for quick editing my latex files with embeded R code.

Together these tools help to create reproducible research; no more errors because the data was updated, after the text was written, no more graphs at wrongfully labeled.

Some errors are hard to eradicate with technology (like wrongful conclusions). But some errors are just not necessary anymore, because convenient tools exist.

I owe a great deal of productivity to the creator if knitr  Yihui Xie.

http://yihui.name/knitr/demos

To get started on reproducible research go here: http://users.stat.umn.edu/~geyer/Sweave/#reproduce

I have written a modul to download data from eurostat into stata
get more information here
https://sites.google.com/site/eustatuse/home

Economists and literature

The well-known (though apparently fictional (Clark, 2009)) dialogue runs as follows.
Fitzgerald: “The rich are different from us, Ernest”. Hemingway: “Yes, Scott, they have more
money than we do”.

[found in http://www.economics.ox.ac.uk/members/peter.neary/confs/papers/oulton.pdf]

Git for stata

I use stata on a remote terminal server. This makes creating graphics fast, but how do I include them in the paper that I am writting locally in Word?

Well, I use git:

after having created the graphics in my working directory on the server i type "git" on the stata prompt. This checks in all the changes to my do files and all newly created grahpics.

In my client I then use "git pull [server] master"  to get the changes. Git is faster then normal file transfer AND it versions all the files.

The git function in stata I use is the following:



capture program drop git
program define git
! D:\kutsam\git\silentsync.bat `1'
forvalues r=1/100 {
        local val=r(o`r')
        if (length("`val'")>1){
        di `"`val'"'
        }
}
end


The silentsync.bat is:


set gitdir=d:\kutsam\git
set path=%gitdir%\cmd;%path%

rem Do not use "echo off" to not affect any child calls.
setlocal
rem Get the abolute path to the current directory, which is assumed to be the
rem Git installation root.
for /F "delims=" %%I in ("%~dp0") do @set git_install_root=%%~fI
set PATH=%git_install_root%\bin;%git_install_root%\mingw\bin;%git_install_root%\cmd;%PATH%

if not exist "%HOME%" @set HOME=%HOMEDRIVE%%HOMEPATH%
if not exist "%HOME%" @set HOME=%USERPROFILE%

set PLINK_PROTOCOL=ssh
cd %HOME%



k:
cd k:\git\da
git add *
git commit -a -m "."
git pull jo master
git pull leontief master

cd d:\kutsam\gitlokal
d:
git add *
git commit -a -m "."
git pull luxor master

k:
%1

Git for economists

If you have not heard of version control systems you have either never programmed, or you are missing out on a really helpful tool.

 A version control system remembers all the different versions of a project. If you have ever programmed a STATA or R script you have run into the situation where somethin does not work any more that did work... yesterday.

A really nice version control system is GIT.   I have switched over from Subversion today, after having watched this video of linus torvals http://www.youtube.com/watch?v=4XpnKHJAok8

Git works without a central repository, so I have my complete code base with me- -not matter what device I work on.