Xtable、Swave、R、交叉表中的计数和百分比

在tables包中,它是一行:

使用BookTabs,您可以得到这个(可以进一步定制):。

使用BookTabs,您可以得到(可以进一步定制):

很好的问题,这个问题困扰了我一段时间(不是 那个 很难,只是我太懒了…像往常一样。然而。。。尽管这个问题很好,但恐怕你的方法不是。有一个叫做 xtable 你可以误用的。此外,这个问题太普遍了——很有可能已经有现成的解决方案了。 互联网 .

总有一天,我将一劳永逸地解决这个问题(我将把代码发布到Github上)。主要的想法是这样的:您希望频率和/或百分比值在一个单元格内(用\分隔)还是连续的绝对和相对频率行(或%)中?我要和2号一起去 ^钕 首先,我将发布一个“急救”解决方案:

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)

干杯!

我不知道如何使用xtable生成多列标题,但我确实意识到为了打印的目的,我可以将计数和百分比连接到同一列中。不理想,但似乎能完成工作。以下是我写的函数:

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 = " ")
    ))
}
@

使用 multicoumn with laTex from the hmisc package is not too bad.此最小swave文档:

\documentClass文章
\开始文档

<<echo=false,results=tex>。=
图书馆(HMISC)
Dow<-样本(1:7,100,替换为真)
目的-样本(1:4,100,替换为真)
道指系数(道指,1:7,C(“周一”,“周二”,“周三”,“周四”,“周五”,“周六”,“周日”))
用途系数(用途,1:4,C(“商务”、“通勤”、“度假”、“其他”))
tbl<-表(dow,purp)
tbl_prop<-圆形(100*道具表(tbl,1),2)

tbl_df<-as.数据.帧.矩阵(tbl)
tbl_prop_df<-as.data.frame.matrix(tbl_prop)
colnames(tbl_prop_df)<-粘贴(colnames(tbl_prop_df),“1”,sep=“)
df<-cbind(tbl_df,tbl_prop_df)[,ggplot2:::交错(1:4,5:8)]
colnames(df)<-rep(c('n','\%'),times=4)

乳胶(object=df,file=“”,cgroup=colnames(tbl_df)),
colheads=空,rowLabel=“,
center=“centering”,collabel.just=rep(“r”,8))。
@

\Enter {文档}
< /代码> 

为我制作:



显然,我已经硬编码了相当多的东西,并且可能会有更灵活的方法来生成最终传递给乳胶的数据帧,但这至少应该让我们开始使用multicolum。


此外,我还使用了一个很小的gotcha,当组合计数和百分比以替换列时,我使用了ggplot2'sinterleavefunction。那只是因为我懒惰。

C包装还不错。此最小swave文档:


\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}


为我制作:



很明显,我已经硬编码了相当多的东西,并且可能有更巧妙的方法来生成最终传递给您的数据帧。乳胶但这至少应该让我们开始使用multicolum.

还有一点,我用过GGPROTT2的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 价值观

我知道这个线程有点旧,但是reporttools包中的tablenominal()函数可能提供了您正在寻找的功能。

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