使用 R 创建大型多列频率表

Question

我很难有效地做到这一点，如果这是一个基本问题，我深表歉意。我需要制作一个包含 N 和百分比的列联表来总结大量二元变量之间的关系，仅根据频率和百分比，没有其他汇总统计。

具体来说，它是总结具有样本类型 X 和临床结果 Y 的患者数量。一个患者可以有任意数量的结果和任意数量的样本，即每个变量是非互斥且独立的。

我想将所有结果（死亡、ICU 入院、腿脱落......）作为列，并将所有样本类型（血清、尿液等......）作为行。我只需要列出“阳性”反应的频率和百分比，即 N 和死亡和有尿样的患者的百分比。

有没有可以帮助这种桌子的软件包？我发现的所有东西都适合做一个漂亮的 1xN 变量列联表。如果我能以某种方式提取该输出的一列并将它们绑定到一个主表中以统治它们，我不介意为每个结果制作一个单独的表。另一个想法是以某种方式制作两个 mChoice（Hmisc 包）变量的频率表。我不知道这两种策略是否可行。

有什么想法吗？

我正在寻找的是这样的：

+-------------+--------+---------+
|             | Death  | ICU     |
|             | (N=10) | (N=50)  |
+-------------+--------+---------+
|Serum (N=50) |5 (50%) | 30 (60%)|
+-------------+--------+---------+
|Urine (N=40) |10(100%)| 7 (14%) |
+-------------+--------+---------+
|Brain (N=25) |6 (60%) | 15 (30%)|
+-------------+--------+---------+
|Kidney (N=50)|7 (70%) | 40 (80%)|
+-------------+--------+---------+

编辑以包含示例数据：

set.seed(1)
death<-runif(1000)<=.75
ICU<-runif(1000)<=.63
serum<-runif(1000)<=.80
urine<-runif(1000)<=.77
brain<-runif(1000)<=.92
kidney<-runif(1000)<=.22
df<-as.data.frame(cbind((1:1000),death,ICU,serum,urine,brain,kidney))

Answer 1

这是一个使用data.table 包的简单快速的解决方案。

library(data.table)

# convert your data frame to data.table
  setDT(df)


# create the output for serum
  serum <- df[serum==1, .(test="serum",
                          test.N = .N, 
                          death.count = sum(death),
                          death.N = sum(df$death),
                          death.prop=(sum(death)/sum(df$death))*100,
                          icu.count = sum(ICU),
                          icu.N = sum(df$ICU),
                          icu.prop=(sum(ICU)/sum(df$ICU))*100),
                          by=.(serum)]

# create the output for kidney
  kidney<- df[kidney==1, .(test="kidney",
                          test.N = .N, 
                          death.count = sum(death),
                          death.N = sum(df$death),
                          death.prop=(sum(death)/sum(df$death))*100,
                          icu.count = sum(ICU),
                          icu.N = sum(df$ICU),
                          icu.prop=(sum(ICU)/sum(df$ICU))*100),
                          by=.(kidney)]

# Bind outputs into a table
  table <- rbind( serum[,2:9,with = FALSE],
                  kidney[,2:9,with = FALSE])

table
>      test test.N death.count death.N death.prop icu.count icu.N icu.prop
> 1:  serum    806         602     752   80.05319       511   632 80.85443
> 2: kidney    190         141     752   18.75000       128   632 20.25316

Answer 2

编辑：这是与原始海报讨论问题后提供的修订答案。未解决手头问题的较旧答案保留在下面以供后代使用。

这个答案既不简短也不简洁，我希望有一种更简洁的方法。但以下将起作用：

## generate example data
set.seed(1)
death<-runif(1000)<=.75
ICU<-runif(1000)<=.63
serum<-runif(1000)<=.80
urine<-runif(1000)<=.77
brain<-runif(1000)<=.92
kidney<-runif(1000)<=.22
df<-as.data.frame(cbind((1:1000),death,ICU,serum,urine,brain,kidney))

## load up our data manipulation workhorses
library(reshape2)
library(plyr)

## save typing by saving row and column var names
row.vars <- c("serum", "urine", "brain", "kidney")
col.vars <- c("death", "ICU")

## melt data so we have death/icu in a column
dat.m <- melt(df, measure.vars = row.vars)

## get rid of rows with death==0 and ICU==0
dat.m <- dat.m[dat.m$value == 1, ]

## for each of death and icu calculate proportion of 1's
tab <- ddply(dat.m, "variable", function(DF) {
  colwise(function(x) length(x[x==1]))(DF[col.vars])
})

## calculate overall proportions for row and column vars
row.nums <- sapply(df[row.vars], function(x) length(x[x==1]))
col.nums <- sapply(df[col.vars], function(x) length(x[x==1]))

## paste row and column counts into row and column names
rownames(tab) <- paste(tab$variable, " (N=", row.nums, ")", sep="")
tab$variable <- NULL
colnames(tab) <- paste(names(tab), " (N=", col.nums, ")", sep="")

## calculate cell proportions and paste them in one column at a time
tab[[1]] <- paste(tab[[1]],
                  " (",
                  round(100*(tab[[1]]/col.nums[[1]]), digits=2),
                  "%)",
                  sep="")
tab[[2]] <- paste(tab[[2]],
                  " (",
                  round(100*(tab[[2]]/col.nums[[2]]),
                        digits=2),
                  "%)",
                  sep="")

现在我们可以

## behold the fruits of our labor
tab
               death (N=752)  ICU (N=632)
serum (N=806)   602 (80.05%) 511 (80.85%)
urine (N=739)   556 (73.94%)  462 (73.1%)
brain (N=910)   684 (90.96%) 576 (91.14%)
kidney (N=190)  141 (18.75%) 128 (20.25%)

旧答案（不能解决手头的问题，但可能对相关任务有用）

这是看起来应该很容易的事情之一，但不知何故并非如此。

有一个existing question 解决了这个问题，一旦你有两列准备制表。这部分很简单：

# function to genderate example data
mkdat <- function() factor(sample(letters[1:4], 10, replace=TRUE), levels=letters[1:4])

# make example data
set.seed(10)
dat <- data.frame(id = 1:10, var1 = mkdat(), var2=mkdat(), var3=mkdat())

# use reshape2 package to reshape from wide to long form
library(reshape2)
dat.m <- melt(dat, id.vars="id")
dat.m$value <- factor(dat.m$value)

现在dat.m$variable 和dat.m$value 的交叉表给出了正确的单元格。您可以参考上面的链接问题，了解如何从那里继续获取表格中的计数和百分比，或者您可以使用此方法：

# tabulate
library(plyr)
tab <- ddply(dat.m, "variable",
             function(DF) {
               # get counts with table
               count <- table(DF$value)
               # convert counts to percent
               prop <- paste(prop.table(count)*100, "%", sep="")
               # combine count and percent
               cp <- paste(count, " (", prop, ")", sep="")
               # re-attach the names
               names(cp) <- levels(DF$value)
               return(cp)
             })

# get row n
tab.r <- table(dat.m$variable)
# get column n
tab.c <- table(dat.m$value)
# paste row and column n into row and column names
colnames(tab) <- paste(colnames(tab), " (n = ", tab.c, ")", sep="")
rownames(tab) <- paste(tab$variable, " (n = ", tab.r, ")", sep="")
tab$variable <- NULL

# works, but that was way too much effort.
print(tab)

必须承认，对于一个简单的计数和比例表来说，这需要做很多工作。如果有人提出更简单的方法，我会很高兴。