Conteggi e percentuali in XTABLE, Sweave, R, tabulazioni incrociate
https://stackoverflow.com/questions/3444440
italiano
english
français
española
中国
日本の
العربية
Deutsch
한국어
Português
RussianDomanda
Modifica: Costruzione off di risposta di aL3xa di seguito, ho modificato la sua sintassi di seguito. Non perfetto, ma sempre più vicino. Non ho ancora trovato un modo per rendere XTABLE accettare \ multicolumn {} argomenti per le colonne o righe. Sembra anche che Hmisc gestisce alcuni di questi tipo di attività dietro le quinte, ma sembra un po 'di un'impresa per capire che cosa sta succedendo lì. Qualcuno ha esperienza con la funzione di lattice in 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)
}
Vorrei creare una tabella formattata per l'output LaTeX che contiene sia i conteggi e le percentuali per ogni colonna o variabile. Non ho trovato una soluzione già pronta a questo problema, ma sento devo essere ricreare la ruota in una certa misura.
ho sviluppato una soluzione per tabulati diritte, ma sto lottando con l'adozione di qualcosa per un tabulazione croce.
Per prima alcuni dati di esempio:
#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 ora il lavoro funzione di scheda dritto:
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")
Qualcuno ha qualche suggerimento per l'adozione di questo per tabulazioni incrociati (vale a dire il giorno della settimana BY scopo del viaggio)? Ecco quello che ho attualmente scritto, che non usa la libreria XTABLE e funziona quasi, ma non è dinamica ed è abbastanza brutto per lavorare 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")
Soluzione 3
Non è stato in grado di capire come generare un colpo di testa a più colonna utilizzando XTABLE, ma mi rendevo conto che avrei potuto concatenare i miei conteggi e percentuali nella stessa colonna durante la stampa. Non è l'ideale, ma sembra ottenere il lavoro fatto. Ecco la funzione che ho scritto:
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))
}
Probabilmente non il prodotto finale, ma non consente una certa flessibilità nei parametri. Al livello più elementare, è solo un involucro di table() ma può anche generare LaTeX formattato uscita pure. Ecco quello che ho finito per usare in 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 = " ")
))
}
@
Altri suggerimenti
Nel Tabelle pacchetto è una linea:
# 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 ))
Utilizzando booktabs, si ottiene questo (può essere ulteriormente personalizzato):
Grande questione, di questo mi dà fastidio per un po '(non è che difficile, è solo a me di essere pigro come l'inferno ... come al solito). Tuttavia ... anche se grande della domanda, il tuo approccio, temo, non lo è. C'è inestimabile pacchetto chiamato xtable che si può (mis) uso. Inoltre, questo problema è troppo comune - c'è una grande possibilità che ci sia già qualche soluzione seduto da qualche parte ready-made su Internets .
Uno di questi giorni che sto per lavorare fuori una volta per tutte (vi posterò il codice su GitHub). L'idea principale va un po 'come questo: vuoi frequenza e / o valori percentuali entro una cella (separati da \) o righe con frequenze assolute e relative (o%) in successione? Mi piacerebbe andare con il 2 o uno, quindi vi posto una soluzione "pronto soccorso" per ora:
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)
}
Ora provare qualcosa di simile:
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%
Assicurarsi di aver caricato il pacchetto xtable e l'uso print (si tratta di una funzione generica, quindi è necessario passare un oggetto classificato xtable). E 'importante che si elimina i nomi di riga. Io ottimizzare questo domani - dovrebbe essere xtable compatibili. E '3:00 nel mio fuso orario, quindi con queste righe che finirò la mia risposta:
print(xtable(ctab(tb)), include.rownames = FALSE)
Cheers!
Uso multicolumn con latex dal Hmisc pacchetto non è troppo male. Questo documento Sweave minima:
\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 questo per me:
Ovviamente, ho hard-coded un bel po 'di roba, e ci potrebbero essere modi Slicker per produrre il frame di dati che si finisce per passare a latex, ma questo dovrebbe almeno dare un inizio utilizzando multicolum.
Inoltre, una leggera Gotcha, ho usato ggplot2 's funzione interleave quando si combinano i conteggi e le percentuali di alternare le colonne. Questo è solo perché sono pigro.
Come questo lavoro per voi?
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)
Non dare belle multicolumns, e non ho abbastanza esperienza con xtable per capire se è possibile. Tuttavia, se avete intenzione di scrivere funzioni personalizzate, si potrebbe provare uno che opera sui nomi delle colonne di df.print. Si potrebbe essere ancora in grado di scrivere una sufficientemente generale di adottare tutti i tipi di frame di dati rifusione come input.
Modifica
Basta il pensiero di una buona soluzione per arrivare più vicino. Dopo aver creato 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)
Ora, ogni cellula conterrà valori N / percent
mi rendo conto questa discussione è un po 'vecchio, ma la funzione tableNominal () nel pacchetto reporttools può fornire la funzionalità che si sta cercando.
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
