目的

lm 関数が返すオブジェクトを LaTeX ソースとして出力する。

使用法

xtable.lm(ans1, caption="caption", label="label",
          vif=FALSE, align="lrrrrrr", digits=rep(3, 6),
          footnote=rep(TRUE, 4), rev=-1.5, 
          booktabs=FALSE, type=c("latex", "html"))

引数

obj                   lm が返すオブジェクト
caption="caption"     キャプション
label="label"         ラベル
vif=FALSE             FALSE（デフォルト）の場合にはトレランス，TRUE の場合には VIF(Variance Infrated Factor) を出力する
align="lrrrrrr"       各フィールドにおける要素の配置（l,c,r）をひとつの文字列で表す
digits=rep(3, 6)      小数点以下の桁数
footnote=rep(TRUE, 4) 表注として4つの要素を出力するかどうかを表す，4要素を持つ論理値ベクトル
rev=-1.5              行間を詰めるための，逆改行の大きさをミリ単位で指定（逆改行しない場合には 0 を指定する）
booktabs=FALSE        TRUE なら \hline の代わりに \toprule, \midrule, \bottomrule を使う
type                  デフォルトは latex。html ソースを出力する場合には html を指定する

ソース

インストールは，以下の 1 行をコピーし，R コンソールにペーストする
source("http://aoki2.si.gunma-u.ac.jp/R/src/xtable-lm.R", encoding="euc-jp")

xtable.lm <- function(obj, caption="caption", label="label", vif=FALSE, align="lrrrrrr", digits=rep(3, 6), footnote=rep(TRUE, 4), rev=-1.5, booktabs=FALSE, type=c("latex", "html"), suf=FALSE) {
# lm 関数が返すオブジェクトを LaTeX または html ソースとして出力する
        conv <- function(s) { # 添字を数式モードで
                if (suf) paste0("$", sub("([0-9]+$)", "_{\\1}", s), "$") else s
        }               
        ans2 <- summary(obj)
        ans <- data.frame(ans2$coefficients)
        df <- obj$model
        d <- model.matrix(obj$terms, eval(obj$model, parent.frame()))
        ans$std.est <- c(NA, obj$coefficients[-1] * apply(d[, -1, drop=FALSE], 2, sd) / sd(obj$model[, 1]))
        ans$append <- c(NA, diag(solve(cor(d[,-1, drop=FALSE]))))
        name.append <- "VIF"
        if (!vif) {
                ans$append <- 1/ans$append
                name.append <- "トレランス"
        }
        if (booktabs) {
                TOPRULE <- "toprule"
                MIDRULE <- "midrule"
                BOTTOMRULE <- "bottomrule"
        }
        else {
                TOPRULE <- MIDRULE <- BOTTOMRULE <- "hline"
        }
        ans <- rbind(ans[-1,], ans[1,])
        rownames(ans)[nrow(ans)] <- "定数項"
        colnames(ans) <- c("偏回帰係数", "標準誤差", "$t$値", "$P$値", "標準化偏回帰係数", name.append)
        n <- nrow(ans)
        f <- ans2$fstatistic[1]
        df1 <- ans2$fstatistic[2]
        df2 <- ans2$fstatistic[3]
        p <-  pf(f, df1, df2, lower.tail=FALSE)
        if (p < 0.001) {
                p <- " < 0.001"
        } else {
                p <- sprintf(" = %.3f", p)
        }
        if (match.arg(type) == "latex") {
                cat(sprintf('\\begin{table}[htbp]\n\\caption{%s}\n\\label{%s}\n\\centering\n\\begin{tabular}{%s} \\%s\n', caption, label, align, TOPRULE))
        
                cat(paste(c("", colnames(ans)), collapse=" & "))
                cat(sprintf("\\\\ \\%s \n", MIDRULE))
                for (i in 1:n) {
                        cat(conv(rownames(ans)[i]))
                        for (j in 1:6) {
                                if (is.na(ans[i,j])) {
                                        cat(" & ")
                                }
                                else if (j == 4 && ans[i,j] < 0.001) {
                                        cat(" & $< 0.001$")
                                }
                                else {
                                        format <- sprintf(" & $%%.%if$", digits[j])
                                        cat(sprintf(format, ans[i,j]))
                                }
                        }
                        cat("\\\\")
                        if (i < n-1) cat(sprintf("[%smm]", rev))
                        if (i == n-1) cat(sprintf("\\%s\n", MIDRULE))
                        cat("\n")
                }
                cat(sprintf("\\%s\n", BOTTOMRULE))
                if (footnote[1]) {
                        cat(sprintf("&\\multicolumn{6}{l}{重相関係数 $R = %.3f$}\\\\[%smm]\n", sqrt(ans2$r.squared), rev))
                }
                if (footnote[2]) {
                        cat(sprintf("&\\multicolumn{6}{l}{重相関係数の二乗（決定係数）$R^2 = %.3f$}\\\\[%smm]\n", ans2$r.squared, rev))
                }
                if (footnote[3]) {
                        cat(sprintf("&\\multicolumn{6}{l}{自由度調整済み重相関係数の二乗 $= %.3f$}\\\\[%smm]\n", ans2$adj.r.squared, rev))
                }
                if (footnote[4]) {
                        cat(sprintf("&\\multicolumn{6}{l}{回帰の分散分析：$F値(%i, %i) = %.3f$，$P 値%s$}\\\\[%smm]\n", df1, df2, f, p, rev))
                }
                cat(" \\end{tabular}\\end{table}\n")
        }
        else {
                align <- unlist(strsplit(align, ""))[-1]
                align <- sub("r", "right", align)
                align <- sub("l", "left", align)
                align <- sub("c", "center", align)
                colnames(ans) <- c("偏回帰係数", "標準誤差", "\\(t\\) 値", "\\(P\\) 値", "標準化偏回帰係数", name.append)
                cat("<TABLE border=1>\n")
                cat(sprintf("<CAPTION ALIGN='top'> %s </CAPTION>\n", caption))
                cat(paste(c("<TR> <TH> ", colnames(ans)), collapse=" </TH> <TH> "))
                cat(" </TH> </TR>\n")
                for (i in 1:n) {
                        cat("  <TR> <TD>", rownames(ans)[i])
                        for (j in 1:6) {
                                if (is.na(ans[i,j])) {
                                        cat(sprintf(" </TD> <TD align='%s'> ", align[j]))
                                }
                                else if (j == 4 && ans[i,j] < 0.001) {
                                        cat(sprintf(" </TD> <TD align='%s'> &lt; 0.001 ", align[j]))
                                }
                                else {
                                        format <- sprintf(" </TD> <TD align='%s'> %%.%if", align[j], digits[j])
                                        cat(sprintf(format, ans[i,j]))
                                }
                        }
                        cat(" </TD> </TR>\n")
                 }
                if (footnote[1]) {
                        cat(sprintf("<TR> <TD colspan=7> 重相関係数 \\(R\\) = %.3f </TD> </TR>\n", sqrt(ans2$r.squared), rev))
                }
                if (footnote[2]) {
                        cat(sprintf("<TR> <TD colspan=7> 重相関係数の二乗（決定係数）\\(R^2\\) = %.3f </TD> </TR>\n", ans2$r.squared, rev))
                }
                if (footnote[3]) {
                        cat(sprintf("<TR> <TD colspan=7> 自由度調整済み重相関係数の二乗 = %.3f </TD> </TR>\n", ans2$adj.r.squared, rev))
                }
                if (footnote[4]) {
                if (p == " < 0.001") {
                        p <- " &lt; 0.001"
                }
                        cat(sprintf("<TR> <TD colspan=7> 回帰の分散分析：\\(F\\)値(%i, %i) = %.3f，\\(P\\) 値%s </TD> </TR>\n", df1, df2, f, p))
                }
                cat("   </TABLE>\n")
        }
}


使用例

ans <- lm(Petal.Width ~ Sepal.Length + Sepal.Width + Petal.Length , data=iris)
librqry(xtable) # 関数名として xtable.lm を使うなら不要
xtable(ans, vif=TRUE, footnote=c(FALSE, TRUE, FALSE, TRUE))

LaTeX でタイプセットすると以下のようになる。


xtable ライブラリ中にも xtable.lm がある。そちらを使うときには

library(xtable)
xtable:::xtable.lm(ans)