Подсчеты и проценты в xTable, Sweave, R, перекрестных таблицах
https://stackoverflow.com/questions/3444440
italiano
english
français
española
中国
日本の
العربية
Deutsch
한국어
Português
RussianВопрос
Редактировать:Опираясь на ответ aL3xa ниже, я изменил его синтаксис ниже.Не идеально, но приближается.Я до сих пор не нашел способа заставить xtable принимать аргументы \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)
}
Я хотел бы создать таблицу, отформатированную для вывода LaTeX, которая содержит как количество, так и проценты для каждого столбца или переменной.Я не нашел готового решения этой проблемы, но чувствую, что должен в какой-то степени воссоздать колесо.
Я разработал решение для прямых таблиц, но пытаюсь применить что-то для перекрестных таблиц.
Сначала несколько примеров данных:
#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
Я не смог выяснить, как генерировать мультиконкуулковый заголовок, используя ZTABLE, но я понял, что смогу объединить мои счетчики и проценты в тот же столбец для целей печати. Не идеально, но, похоже, заставит работу. Вот функция, которую я написал:
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() Но также может также генерировать отформатированный латекс. Вот то, что я закончил использовать в 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 = " ")
))
}
@
Другие советы
В таблицах-пакете это одна строка:
# 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, вы получаете это (можно дальше настроить):
Отличный вопрос, он меня беспокоит какое-то время (это не что тяжело, это я просто чертовски ленив...по-прежнему).Однако...хотя вопрос замечательный, боюсь, ваш подход не таков.Есть бесценный пакет под названием xtable что вы можете (неправильно) использовать.Кроме того, эта проблема слишком распространена — велика вероятность, что где-то уже лежит какое-то готовое решение. Интернеты.
На днях я собираюсь разобраться с этим раз и навсегда (код выложу на GitHub).Основная идея звучит примерно так:вы хотите, чтобы значения частоты и/или процента находились в одной ячейке (разделенной символом \) или в строках с абсолютными и относительными частотами (или %) подряд?я бы выбрал 2nd один, поэтому я пока опубликую решение «первой помощи»:
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. Пакет не слишком плох. Этот минимальный Sweave документ:
\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.С. 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. Отказ Возможно, вы даже можете написать одно достаточно общему, чтобы взять все способы переградывания кадров данных в качестве ввода.
Редактировать:Просто подумал о хорошем решении, чтобы получить вас ближе. После создания 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 значения
Я понимаю, что эта нить немного старая, но функция Tablenominal () в пакете ReportTools может предоставить функциональные возможности, которые вы ищете.
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
