Contagens e porcentagens em xxtable, Swave, r, tabulações cruzadas
https://stackoverflow.com/questions/3444440
italiano
english
français
española
中国
日本の
العربية
Deutsch
한국어
Português
RussianPergunta
EDIT: Construindo a resposta da Al3xa abaixo, modifiquei sua sintaxe abaixo. Não é perfeito, mas se aproximando. Ainda não encontrei uma maneira de fazer Xtable aceitar multicolumn {} argumentos para colunas ou linhas. Parece também que o HMISC lida com alguns desses tipos de tarefas nos bastidores, mas parece um empreendimento para entender o que está acontecendo lá. Alguém tem experiência com a função de látex no 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)
}
Gostaria de criar uma tabela formatada para saída de látex que contém as contagens e as porcentagens de cada coluna ou variável. Não encontrei uma solução pronta para esse problema, mas sinto que devo recriar a roda até certo ponto.
Eu desenvolvi uma solução para tabulações retas, mas estou lutando para adotar algo para uma tabulação cruzada.
Primeiro alguns dados de amostra:
#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"))
E agora a função de guia reta que trabalha:
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")
Alguém tem alguma sugestão para adotar isso para tabulações cruzadas (ou seja, dia da semana por fins de viagem)? Aqui está o que escrevi atualmente, que não usa a biblioteca xtable e quase funciona, mas não é dinâmico e é muito feio para trabalhar:
#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")
Solução 3
Não consegui descobrir como gerar um cabeçalho de várias colunas usando Xtable, mas percebi que poderia concatenar minhas contagens e porcentagens na mesma coluna para fins de impressão. Não é o ideal, mas parece fazer o trabalho. Aqui está a função que escrevi:
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))
}
Provavelmente não é o produto final, mas permite alguma flexibilidade nos parâmetros. No nível mais básico, é apenas um invólucro de table() mas também pode gerar saída formatada em látex também. Aqui está o que eu acabei usando em um Sweave documento:
<<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 = " ")
))
}
@
Outras dicas
No pacote de tabelas, é uma linha:
# 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 ))
Usando o BookTabs, você obtém isso (pode ser ainda mais personalizado):
Ótima pergunta, este está me incomodando por um tempo (não é este Hard, sou apenas eu sendo preguiçoso como o inferno ... como sempre). No entanto ... embora a pergunta seja ótima, sua abordagem, receio, não é. Há um pacote inestimável chamado xtable que você pode (mal) usar. Além disso, esse problema é muito comum - há uma grande chance de que já exista uma solução pronta sentada em algum lugar em as internets.
Um dia desses estou prestes a resolver de uma vez por todas (postarei o código no Github). A idéia principal é um pouco assim: você gostaria de frequência e/ou valores percentuais em uma célula (separados por ) ou linhas com frequências absolutas e relativas (ou %) em sucessão? Eu iria com o 2nd um, então vou postar uma solução de "primeiros socorros" por enquanto:
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)
}
Agora tente algo como:
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%
Certifique -se de carregar xtable pacote e uso print (é uma função genérica, então você deve passar um xtable objeto classificado). É importante que você suprime os nomes das linhas. Vou otimizar este amanhã - deve ser xtable compatível. São 3 da manhã no meu fuso horário, então com essas linhas terminarei minha resposta:
print(xtable(ctab(tb)), include.rownames = FALSE)
Felicidades!
Usando multicolumn com latex de Hmisc O pacote não é tão ruim. Este documento mínimo de 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}
Produz isso para mim:
Obviamente, eu codifiquei um pouco de coisas e pode haver maneiras mais difíceis de produzir o quadro de dados que você passa latex, mas isso deve pelo menos dar um começo usando multicolum.
Além disso, um pequeno gotcha, eu usei ggplot2's interleave Função ao combinar as contagens e porcentagens para alternar as colunas. Isso é só porque sou preguiçoso.
Como isso funcionaria para você?
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)
Não lhe dá boas multicolumnas, e eu não tenho experiência suficiente com xtable Para descobrir se isso é possível. No entanto, se você estiver escrevendo funções personalizadas, poderá tentar uma que opera com os nomes de colunas de df.print. Você pode até escrever um suficientemente geral para obter todo tipo de reformular os quadros de dados como entrada.
Editar:Apenas pensei em uma boa solução para aproximá -lo. Depois de criar 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)
Agora, toda célula conterá N / percent valores
Sei que esse tópico é um pouco antigo, mas a função tablenominal () no pacote ReportTools pode fornecer a funcionalidade que você está procurando.
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
