Counts y porcentajes en XTABLE, Sweave, R, tabulaciones cruzadas
https://stackoverflow.com/questions/3444440
italiano
english
français
española
中国
日本の
العربية
Deutsch
한국어
Português
RussianPregunta
Editar: Construcción fuera de la respuesta de aL3xa A continuación, he modificado la sintaxis siguiente. No es perfecto, pero cada vez más cerca. Todavía no he encontrado una manera de hacer aceptar xtable \ varias columnas {} argumentos para las columnas o filas. También parece que Hmisc maneja algunos de estos tipos de tareas detrás de las escenas, pero parece que un poco de una empresa para entender lo que está pasando allí. ¿Alguien tiene experiencia con la función de látex en 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)
}
Me gustaría para crear una tabla con formato para la salida de látex que contiene tanto los recuentos y porcentajes para cada columna o variable. No he encontrado una solución ya preparada para este problema, pero siento que debo estar recreando la rueda hasta cierto punto.
he desarrollado una solución para las tabulaciones rectas, pero estoy luchando con la adopción de algo para una tabulación cruzada.
En primer lugar algunos datos de ejemplo:
#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"))
Y ahora la función de la ficha recta de trabajo:
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")
¿alguien tiene alguna sugerencia para la adopción de esta para tabulaciones cruzadas (es decir, día de la semana según motivo del viaje)? Esto es lo que he escrito en la actualidad, que no utiliza la biblioteca xtable y funciona casi, pero no es dinámica y es bastante feo para el trabajo con:
#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")
Solución 3
No fue capaz de encontrar la manera de generar una cabecera de columna utilizando múltiples xtable, pero me daba cuenta de que yo podría concatenar mis recuentos y porcentajes en la misma columna para la impresión de los propósitos. No es ideal, pero parece hacer el trabajo. Aquí está la función que he escrito:
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))
}
Probablemente no sea el producto final, pero permite cierta flexibilidad en los parámetros. En el nivel más básico, es sólo una envoltura de table() pero también puede generar la salida con formato LaTeX también. Esto es lo que terminó usando en un documento 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 = " ")
))
}
@
Otros consejos
En la Tablas-paquete es una línea:
# 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 ))
El uso de booktabs, se obtiene este (se pueden personalizar):
Muy buena pregunta, de éste me está molestando por un tiempo (que no es que duro, se me acaba de ser perezoso como el demonio ... como de costumbre). Sin embargo ... aunque grande de la pregunta, su enfoque, me temo, no lo es. No tiene precio paquete llamado xtable que pueda (mal) uso. Además, este problema es muy común - hay una gran posibilidad de que ya hay alguna solución sentado en algún lugar ya preparado en Internets .
Uno de estos días que voy a trabajar a cabo una vez por todas (Voy a publicar el código en GitHub). La idea principal pasa un poco como esto: ¿Le gustaría valores de porcentaje de frecuencia y / o dentro de una celda (separados por \) o filas con frecuencias absolutas y relativas (o%) en la sucesión? Me quedo con la 2 º uno, así que voy a publicar una solución "primeros auxilios" por ahora:
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)
}
Ahora intente 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%
Asegúrese de que ha cargado el paquete xtable y el uso print (que es una función genérica, por lo que debe pasar un objeto clasificado xtable). Es importante que suprime los nombres de las filas. Voy a optimizar esta mañana uno - debe ser compatible xtable. Es de las 3 de mi zona de tiempo, por lo que con estas líneas voy a terminar mi respuesta:
print(xtable(ctab(tb)), include.rownames = FALSE)
Saludos!
El uso de multicolumn con latex de la paquete Hmisc no es tan malo. Este documento Sweave mínima:
\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}
Produce esto por mí:
Obviamente, he programado en forma fija una buena cantidad de cosas, y no podía haber formas más pulidos para producir la trama de datos que se acaba de pasar a latex, pero esto debería al menos dar un comienzo usando multicolum.
Además, una ligera gotcha, he utilizado ggplot2 's función interleave cuando la combinación de los recuentos y porcentajes para alternar las columnas. Eso es sólo porque soy perezoso.
¿Cómo funcionaría esto para usted?
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)
No le dará buenos multicolumns, y no tiene suficiente experiencia con xtable de averiguar si eso es posible. Sin embargo, si usted va a escribir funciones personalizadas, puede probar con uno que opera a través de los nombres de las columnas de df.print. Usted puede ser incluso capaz de escribir uno lo suficientemente general para tomar todo tipo de tramas de datos de refundición como entrada.
Editar
Acaba de ocurrir una buena solución para conseguir que más cerca. Después de crear 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)
Ahora, cada célula contiene valores N / percent
Me da cuenta de este hilo es un poco viejo, pero la función tableNominal () en el paquete reporttools puede proporcionar la funcionalidad que busca.
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
