Xtable、Sweave、R、クロス集計のカウントとパーセンテージ
https://stackoverflow.com/questions/3444440
italiano
english
français
española
中国
日本の
العربية
Deutsch
한국어
Português
Russian質問
編集：以下のAl3XAの回答から構築すると、以下に彼の構文を変更しました。完璧ではありませんが、近づく。私はまだ、列または行のXtable Accept multicolumn {}引数を作成する方法をまだ見つけていません。また、HMISCは舞台裏でこれらのタイプのタスクの一部を処理しているように見えますが、そこで何が起こっているのかを理解するための少しの取り組みのように見えます。 HMISCのラテックス機能の経験はありますか？
ctab <- function(tab, dec = 2, margin = NULL) {
tab <- as.table(tab)
ptab <- paste(round(prop.table(tab, margin = margin) * 100, dec), "%", sep = "")
res <- matrix(NA, nrow = nrow(tab) , ncol = ncol(tab) * 2, byrow = TRUE)
oddc <- 1:ncol(tab) %% 2 == 1
evenc <- 1:ncol(tab) %% 2 == 0
res[,oddc ] <- tab
res[,evenc ] <- ptab
res <- as.table(res)
colnames(res) <- rep(colnames(tab), each = 2)
rownames(res) <- rownames(tab)
return(res)
}
各列または変数のカウントとパーセンテージの両方を含むラテックス出力用にフォーマットされたテーブルを作成したいと思います。私はこの問題の既製の解決策を見つけていませんが、私はある程度ホイールを再現しているに違いないと感じています。
私はまっすぐな表面の解決策を開発しましたが、クロス集計のために何かを採用することに苦労しています。
最初にいくつかのサンプルデータ：
#Generate sample data
dow <- sample(1:7, 100, replace=TRUE)
purp <- sample(1:4, 100, replace=TRUE)
dow <- factor(dow, 1:7, c("Mon", "Tues", "Wed", "Thurs", "Fri", "Sat", "Sun"))
purp <- factor(purp, 1:4, c("Business", "Commute", "Vacation", "Other"))
そして今、作業ストレートタブ関数：
customTable <- function(var, capt = NULL){
counts <- table(var)
percs <- 100 * prop.table(counts)
print(
xtable(
cbind(
Count = counts
, Percent = percs
)
, caption = capt
, digits = c(0,0,2)
)
, caption.placement="top"
)
}
#Usage
customTable(dow, capt="Day of Week")
customTable(purp, capt="Trip Pupose")
クロス集計（つまり、旅行の目的による曜日）にこれを採用するための提案はありますか？私が現在書いているものは次のとおりです。Xtableライブラリを使用しておらず、ほとんど機能していませんが、動的ではなく、：
#Create table and percentages
a <- table(dow, purp)
b <- round(prop.table(a, 1),2)
#Column bind all of the counts & percentages together, this SHOULD become dynamic in future
d <- cbind( cbind(Count = a[,1],Percent = b[,1])
, cbind(Count = a[,2], Percent = b[,2])
, cbind(Count = a[,3], Percent = b[,3])
, cbind(Count = a[,4], Percent = b[,4])
)
#Ugly function that needs help, or scrapped for something else
crossTab <- function(title){
cat("\\begin{table}[ht]\n")
cat("\\begin{center}\n")
cat("\\caption{", title, "}\n", sep="")
cat("\\begin{tabular}{rllllllll}\n")
cat("\\hline\n")
cat("", cat("", paste("&\\multicolumn{2}{c}{",colnames(a), "}"), sep = ""), "\\\\\n", sep="")
c("&", cat("", colnames(d), "\\\\\n", sep=" & "))
cat("\\hline\n")
c("&", write.table(d, sep = " & ", eol="\\\\\n", quote=FALSE, col.names=FALSE))
cat("\\hline\n")
cat("\\end{tabular}\n")
cat("\\end{center}\n")
cat("\\end{table}\n")
}
crossTab(title = "Day of week BY Trip Purpose")
解決 3
Xtableを使用してマルチカラムヘッダーを生成する方法を理解することはできませんでしたが、印刷目的でカウントとパーセンテージを同じ列に連結できることに気付きました。理想的ではありませんが、仕事を成し遂げているようです。これが私が書いた機能です：
ctab3 <- function(row, col, margin = 1, dec = 2, percs = FALSE, total = FALSE, tex = FALSE, caption = NULL){
tab <- as.table(table(row,col))
ptab <- signif(prop.table(tab, margin = margin), dec)
if (percs){
z <- matrix(NA, nrow = nrow(tab), ncol = ncol(tab), byrow = TRUE)
for (i in 1:ncol(tab)) z[,i] <- paste(tab[,i], ptab[,i], sep = " ")
rownames(z) <- rownames(tab)
colnames(z) <- colnames(tab)
if (margin == 1 & total){
rowTot <- paste(apply(tab, 1, sum), apply(ptab, 1, sum), sep = " ")
z <- cbind(z, Total = rowTot)
} else if (margin == 2 & total) {
colTot <- paste(apply(tab, 2, sum), apply(ptab, 2, sum), sep = " ")
z <- rbind(z,Total = colTot)
}
} else {
z <- table(row, col)
}
ifelse(tex, return(xtable(z, caption)), return(z))
}
おそらく最終製品ではありませんが、パラメーターの柔軟性を可能にします。最も基本的なレベルでは、 table() しかし、LaTexフォーマットされた出力も生成することもできます。これが私がaで使用したものです Sweave 資料：
<<echo = FALSE>>=
for (i in 1:ncol(df)){
print(ctab3(
col = df[,1]
, row = df[,i]
, margin = 2
, total = TRUE
, tex = TRUE
, caption = paste("Dow by", colnames(df[i]), sep = " ")
))
}
@
他のヒント
テーブルパッケージでは、1つの行です。
# data:
dow <- sample(1:7, 100, replace=TRUE)
purp <- sample(1:4, 100, replace=TRUE)
dow <- factor(dow, 1:7, c("Mon", "Tues", "Wed", "Thurs", "Fri", "Sat", "Sun"))
purp <- factor(purp, 1:4, c("Business", "Commute", "Vacation", "Other"))
dataframe <- data.frame( dow, purp)
# The packages
library(tables)
library(Hmisc)
# The table
tabular( (Weekday=dow) ~ (Purpose=purp)*(Percent("row")+ 1) ,data=dataframe )
# The latex table
latex( tabular( (Weekday=dow) ~ (Purpose=purp)*(Percent("col")+ 1) ,data=dataframe ))
booktabsを使用して、これを取得します（さらにカスタマイズできます）：
素晴らしい質問、これはしばらく私を悩ませています（それはそうではありません それ 大変な、それはただ私が地獄のように怠zyである...いつものように）。しかし...質問は素晴らしいですが、あなたのアプローチは、私が恐れています、そうではありません。貴重なパッケージが呼ばれています xtable 使用できる（MIS）。それに加えて、この問題はあまりにも一般的です - どこかに既成のソリューションがすでに座っている可能性が高い可能性があります インターネット.
これらの日のうちの1つは、私がそれを完全に解決しようとしています（GitHubにコードを投稿します）。主なアイデアはこのようになります。1つのセル内の周波数および/またはパーセンテージ値（で区切られた）または連続して絶対的および相対周波数（または％）の行が必要ですか？私は2と一緒に行きますnd 1つなので、今のところ「救急」ソリューションを投稿します。
ctab <- function(tab, dec = 2, ...) {
tab <- as.table(tab)
ptab <- paste(round(prop.table(tab) * 100, dec), "%", sep = "")
res <- matrix(NA, nrow = nrow(tab) * 2, ncol = ncol(tab), byrow = TRUE)
oddr <- 1:nrow(tab) %% 2 == 1
evenr <- 1:nrow(tab) %% 2 == 0
res[oddr, ] <- tab
res[evenr, ] <- ptab
res <- as.table(res)
colnames(res) <- colnames(tab)
rownames(res) <- rep(rownames(tab), each = 2)
return(res)
}
今、次のようなものを試してみてください：
data(HairEyeColor) # load an appropriate dataset
tb <- HairEyeColor[, , 1] # choose only male respondents
ctab(tb)
Brown Blue Hazel Green
Black 32 11 10 3
Black 11.47% 3.94% 3.58% 1.08%
Brown 53 50 25 15
Brown 19% 17.92% 8.96% 5.38%
Red 10 10 7 7
Red 3.58% 3.58% 2.51% 2.51%
Blond 3 30 5 8
Blond 1.08% 10.75% 1.79% 2.87%
必ずロードしてください xtable パッケージと使用 print （それは一般的な関数なので、あなたは渡す必要があります xtable 分類されたオブジェクト）。行名を抑制することが重要です。明日これを最適化します - そうあるべきです xtable 互換性。タイムゾーンの午前3時なので、これらの行を使用すると、私の答えは終了します。
print(xtable(ctab(tb)), include.rownames = FALSE)
乾杯！
使用 multicolumn と latex から hmisc パッケージはそれほど悪くありません。この最小限のスイーブドキュメント：
\documentclass{article}
\begin{document}
<<echo = FALSE,results = tex>>=
library(Hmisc)
dow <- sample(1:7, 100, replace=TRUE)
purp <- sample(1:4, 100, replace=TRUE)
dow <- factor(dow, 1:7, c("Mon", "Tues", "Wed", "Thurs", "Fri", "Sat", "Sun"))
purp <- factor(purp, 1:4, c("Business", "Commute", "Vacation", "Other"))
tbl <- table(dow,purp)
tbl_prop <- round(100 * prop.table(tbl,1),2)
tbl_df <- as.data.frame.matrix(tbl)
tbl_prop_df <- as.data.frame.matrix(tbl_prop)
colnames(tbl_prop_df) <- paste(colnames(tbl_prop_df),"1",sep = "")
df <- cbind(tbl_df,tbl_prop_df)[,ggplot2:::interleave(1:4,5:8)]
colnames(df) <- rep(c('n','\\%'),times = 4)
latex(object=df,file="",cgroup = colnames(tbl_df),
colheads = NULL,rowlabel = "",
center = "centering",collabel.just = rep("r",8))
@
\end{document}
私のためにこれを生み出します：
明らかに、私はかなりのものをハードコーディングしました、そして、あなたが渡すことになるデータフレームを生成するための滑らかな方法があるかもしれません latex, 、しかし、これは少なくとも使用を開始する必要があります multicolum.
また、わずかなゴッチャ、私は使用しました ggplot2's interleave 関数カウントとパーセンテージを組み合わせて列を交互に組み合わせるとき。それは私が怠け者だからです。
これはあなたのためにどのように機能しますか？
library(reshape)
library(plyr)
df <- data.frame(dow = dow, purp = purp)
df.count <- count(df)
df.count <- ddply(df.count, .(dow), transform, p = round(freq / sum(freq),2))
df.m <- melt(df.count)
df.print <- cast(df.m, dow ~ purp + variable)
library(xtable)
xtable(df.print)
それはあなたに素敵なマルチコラムを与えません、そして私は十分な経験を持っていません xtable それが可能かどうかを把握するために。ただし、カスタム関数を作成する場合は、の列名を介して動作する機能を試すことができます。 df.print. 。あらゆる種類のリキャストデータフレームを入力として取得するのに十分な一般的な1つを書くことができるかもしれません。
編集：あなたを近づけるための良い解決策を考えました。作成後 df.m
df.preprint <- ddply(df.m, .(dow, purp), function(x){
x <- cast(x, dow ~ variable)
x$value <- paste(x$freq, x$p, sep = " / ")
return(c(value = x$value))
}
)
df.print <- cast(df.preprint, dow ~ purp)
print(xtable(df.print), include.rownames = F)
これで、すべてのセルが含まれます N / percent 値
このスレッドは少し古いことを認識していますが、ReportToolsパッケージのTableNominal（）関数は、探している機能を提供する可能性があります。
tab<-table(row, col)
ctab<-round(100*prop.table(tab,2), 2) # for column percents (see the args for prop.table)
for (i in 1:length(tab)) {
ctab[i]<-paste(tab[i]," (", ctab[i], "%", ")", sep="")
}
require(xtable);
k<-xtable(ctab,digits=1) # make latex table
