Comtes et pourcentages dans XTable, Sweave, R, tableaux croisés
Question
Edit: Se appuyant sur la réponse de aL3xa ci-dessous, j'ai modifié sa syntaxe ci-dessous. Pas parfait, mais se rapprocher. Je n'ai pas encore trouvé un moyen de faire accepter XTABLE \ multicolumn {} arguments pour les colonnes ou lignes. Il apparaît également que gère Hmisc certains de ces types de tâches dans les coulisses, mais il ressemble un peu d'une entreprise de comprendre ce qui se passe là-bas. Quelqu'un at-il une expérience avec la fonction de latex dans 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)
}
Je voudrais créer une table formatée pour la sortie LaTeX contenant à la fois les effectifs et les pourcentages pour chaque colonne ou variable. Je ne l'ai pas trouvé une solution prête faite à ce problème, mais l'impression que je dois réinventer la roue dans une certaine mesure.
J'ai développé une solution pour les totalisations droites, mais je suis aux prises avec l'adoption de quelque chose pour un tableau croisé.
Premières quelques exemples de données:
#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"))
Et maintenant la fonction onglet droit de travail:
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")
Est-ce que quelqu'un a des suggestions pour l'adoption de ce pour les tableaux croisés (c.-à-jour de la semaine selon le but du voyage)? Voici ce que j'ai actuellement écrit, qui n'utilise pas la bibliothèque XTABLE et fonctionne presque, mais n'est pas dynamique et est assez moche à travailler avec:
#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")
La solution 3
Je n'étais pas en mesure de comprendre comment générer un en-tête de plusieurs colonnes en utilisant XTABLE, mais je l'ai réalisé que je pouvais concaténer mes comptes et pourcentages dans la même colonne à des fins d'impression. Pas idéal, mais semble faire le travail. Voici la fonction que j'ai écrit:
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))
}
Probablement pas le produit final, mais ne permet une certaine souplesse dans les paramètres. Au niveau le plus élémentaire, est seulement une enveloppe de table()
mais peut également générer LATEX une mise en forme aussi bien. Voici ce que je fini par utiliser dans un document 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 = " ")
))
}
@
Autres conseils
dans les tableaux du paquet est une ligne:
# 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 ))
Utilisation booktabs, vous obtenez ce (peut être personnalisé):
Bonne question, celui-ci me tracasse pendant un certain temps (ce n'est pas que dur, il est juste moi être paresseux comme l'enfer ... comme d'habitude). Mais ... si j'ai peur, n'est pas la grande, votre approche de la question,. Il y a une valeur inestimable package appelé xtable
que vous pouvez utilisez la (mauvaise). D'ailleurs, cette question est trop commune - il y a une grande chance qu'il ya déjà une solution prête à l'emploi assis quelque part sur les Internets .
L'un de ces jours, je suis sur le point de travailler dehors une fois pour toutes (je posterai le code sur GitHub). L'idée principale va un peu comme ceci: voulez-vous comme la fréquence et / ou des valeurs de pourcentage au sein d'une cellule (séparés par \) ou des lignes avec des fréquences absolues et relatives (ou%) dans la succession? Je vais avec la solution 2 e , donc je vais poster un « premiers secours » pour l'instant:
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)
}
Maintenant, essayez quelque chose comme:
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%
Assurez-vous que vous avez chargé package xtable
et l'utilisation print
(il est une fonction générique, vous devez donc passer un xtable
objet classé). Il est important que vous supprimez les noms de ligne. J'optimiseront celui de demain - il devrait être compatible xtable
. Il de trois heures dans mon fuseau horaire, donc avec ces lignes, je vais finir ma réponse:
print(xtable(ctab(tb)), include.rownames = FALSE)
Vive!
Utilisation multicolumn
avec latex
du Hmisc package est pas trop mal. Ce document Sweave minimal:
\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}
Produit pour moi:
De toute évidence, je l'ai codé en dur un peu de mal de choses, et il pourrait y avoir des moyens de Slicker pour produire la trame de données que vous finissez par passer à latex
, mais cela devrait au moins donner un début à l'aide multicolum
.
En outre, une légère Gotcha, je l'ai utilisé ggplot2 La fonction interleave
de «en combinant les effectifs et les pourcentages d'alterner les colonnes. C'est juste parce que je suis paresseux.
Comment cela fonctionnerait-il pour vous?
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)
Il ne vous donne de belles multicolonnes, et je n'ai pas pas assez d'expérience avec xtable
pour savoir si cela est possible. Cependant, si vous allez être écrire des fonctions personnalisées, vous pouvez essayer un qui fonctionne sur les noms de colonnes de df.print
. Vous pourriez même être en mesure d'écrire une assez générale de prendre toutes sortes de trames de données refondus en entrée.
Edit:
Je pensais juste que d'une bonne solution pour vous rapprocher. Après avoir créé 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)
Maintenant, chaque cellule contient des valeurs de N / percent
Je sais que ce fil est un peu vieux, mais la fonction tableNominal () dans le paquet reporttools peut fournir la fonctionnalité que vous recherchez.
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