xTable中的计数和百分比，Sweave，R，交叉制表

Question

编辑：在以下aL3xa的回答基础上，我修改了他的语法。并不完美，但越来越接近了。我仍然没有找到让xtable接受列或行的\multicolumn {}参数的方法。似乎Hmisc处理了其中一些任务，但要理解发生了什么似乎需要花费一些时间。有没有人熟悉Hmisc中latex函数的使用？

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

我希望创建一个表格，可用于LaTeX输出，其中包含每列或变量的计数和百分比。 我没有找到现成的解决方案，但感觉在某种程度上必须重新创造轮子。

我已经为直接制表开发了一个解决方案，但在采用交叉制表时遇到了困难。

首先是一些样本数据：

#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"))

下面是可用的制表符函数：

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")

有没有人对将这个方法用于交叉表（例如按周几分组，再按出行目的分组）有什么建议？这是我当前编写的代码，它不使用xtable库，几乎能够完美运行，但不够灵活且难以处理：

#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")

- Chase

---

不要硬编码LaTeX，否则它很快就会变得难以管理。HTML也是一样的。看看xtable文档，并瞥一眼我的答案（注意这位自大之人的话）。 - aL3xa

Answer 1

在Tables包中，只需要一行代码：

# 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        ))

使用booktabs，您将获得以下结果（可以进一步自定义）：

- Rasmus Larsen

Answer 2

很好的问题，这个问题困扰了我一段时间（这并不难，只是我太懒惰了……像往常一样）。然而......虽然问题很好，但你的方法，恐怕不行。有一种宝贵的包叫做xtable，你可以（误）用它。此外，这个问题太普遍了——很可能已经有一些现成的解决方案在互联网上某个地方等着呢。

总有一天，我会彻底解决这个问题（我会把代码发布在GitHub上）。主要思路大致如下：您想在一个单元格内获得频率和/或百分比值（由\分隔）还是在连续的行中获得绝对和相对频率（或%）？我会选择第二个，所以现在我会发布一个“急救”方案：

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)

干杯！

- aL3xa

---

再次提醒：请谨慎操作，这段代码是从头开始编写的，没有进行优化。如果导致您的计算机崩溃，我不承担任何责任！=) - aL3xa

Answer 3

我无法想出如何使用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()的包装器，但也可以生成LaTeX格式的输出。以下是我在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 = " ")
    ))
}
@

- Chase

Answer 4

使用Hmisc包中的latex命令与multicolumn一起使用并不难。下面是一个最小化的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}

为我生成这个:

显然，我已经硬编码了很多东西，可能有更简洁的方法来生成你最终传递给latex的数据框，但这至少应该是使用multicolum开始的一个方法。

另外，一个小问题，我在组合计数和百分比时使用了ggplot2的interleave函数来交替列。那只是因为我懒。

- joran

---

有没有办法在星期几上方添加一个粗体标签，最好与“purp”在同一行？ - radek

通用版本以处理不同数量的列：https://pastebin.com/uJpwYbeZ - xbsd

Answer 5

这对你来说怎么样？

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 / 百分比 个值

- JoFrhwld

---

我是否错过了一些非常基础的东西，还是count()不在基本R中？我得到了“错误：找不到函数'count'”和“指定的包和库中没有'count'的文档：您可以尝试'??count'”。搜索“??count”会产生很多结果，但不是我认为你在这里寻找的？或者，我只需要关闭电脑，明天早上再回来看看... - Chase

count 函数在 plyr 包中可用。JoFrhwld 在他的回答的第三行加载了 plyr。使用 library(sos)（首先安装该包）- 当您遇到一些“非常未知”的函数时，findFn("somefunction") 应该会有所帮助。 - aL3xa

由于某些原因，我正在使用 R 2.10，并且 plyr 的行为不恰当...加载 R 2.11.1 后一切正常...我显然需要一些睡眠 - 明天继续。感谢大家的想法！ - Chase

Answer 6

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

- Ademu Onu

Answer 7

我知道这个帖子有点老了，但是reporttools包中的tableNominal()函数可能提供您正在寻找的功能。

- Charlie

---

可以给出一个例子吗（最好带一些输出）？ - Roman Luštrik