创建不同长度的分类变量的汇总表
Posted
技术标签:
【中文标题】创建不同长度的分类变量的汇总表【英文标题】：Create summary table of categorical variables of different lengths 【发布时间】：2013-02-13 05:35:16 【问题描述】：在 SPSS 中，使用“自定义表”创建分类变量的汇总表相当容易：
如何在 R 中做到这一点？
首选通用和可扩展的解决方案，使用 Plyr 和/或 Reshape2 软件包，因为我正在努力学习这些。
示例数据：（mtcars 在 R 安装中）
df <- colwise(function(x) as.factor(x) ) (mtcars[,8:11])
附言
请注意，我的目标是让 one 表中的所有内容如图所示。 我已经挣扎了好几个小时，但我的尝试太糟糕了，发布代码可能不会增加问题的可理解性。
【问题讨论】：
当您说喜欢图片时，您愿意改进还是必须完全匹配该格式？ :) 开放改进:) 【参考方案1】：不幸的是，似乎还没有 R 包可以像 SPSS 一样生成漂亮的输出。大多数用于生成表格的函数似乎都定义了自己的特殊格式，如果您想以其他方式导出或处理表格，这会给您带来麻烦。 但我确信 R 能够做到这一点，所以我开始编写自己的函数。我很高兴与您分享结果（工作正在进行中，但已完成工作）：
以下函数为数据中的所有因子变量返回因子变量“变量”的每个级别的频率或百分比 (calc="perc")。 最重要的可能是输出是一个简单且用户友好的 data.frame。因此，与许多其他功能相比，以任何您想要的方式导出结果并使用它都没有问题。
我意识到还有很大的改进潜力，即增加选择行与列百分比计算的可能性等。
contitable <- function( survey_data, variable, calc="freq" )
# Check which variables are not given as factor
# and exlude them from the given data.frame
survey_data_factor_test <- as.logical( sapply( Survey, FUN=is.factor) )
survey_data <- subset( survey_data, select=which( survey_data_factor_test ) )
# Inform the user about deleted variables
# is that proper use of printing to console during a function call??
# for now it worksjust fine...
flush.console()
writeLines( paste( "\n ", sum( !survey_data_factor_test, na.rm=TRUE),
"non-factor variable(s) were excluded\n" ) )
variable_levels <- levels(survey_data[ , variable ])
variable_levels_length <- length( variable_levels )
# Initializing the data.frame which will gather the results
result <- data.frame( "Variable", "Levels", t(rep( 1, each=variable_levels_length ) ) )
result_column_names <- paste( variable, variable_levels, sep="." )
names(result) <- c("Variable", "Levels", result_column_names )
for(column in 1:length( names(survey_data) ) )
column_levels_length <- length( levels( survey_data[ , column ] ) )
result_block <- as.data.frame( rep( names(survey_data)[column], each=column_levels_length ) )
result_block <- cbind( result_block, as.data.frame( levels( survey_data[,column] ) ) )
names(result_block) <- c( "Variable", "Levels" )
results <- table( survey_data[ , column ], survey_data[ , variable ] )
if( calc=="perc" )
results <- apply( results, MARGIN=2, FUN=function(x) x/sum(x) )
results <- round( results*100, 1 )
results <- unclass(results)
results <- as.data.frame( results )
names( results ) <- result_column_names
rownames(results) <- NULL
result_block <- cbind( result_block, results)
result <- rbind( result, result_block )
result <- result[-1,]
return( result )
【讨论】：
【参考方案2】：您可能会发现以下代码 sn-p 很有用。它利用基本包函数 table、margin.table 和 prop.table，不需要任何其他包。它确实将结果收集到具有命名维度的列表中（这些可以通过 rbind 收集到单个矩阵中）：
dat <- table(mtcars[,8:11])
result <- list()
for(m in 1:length(dim(dat)))
martab <- margin.table(dat, margin=m)
result[[m]] <- cbind(Freq=martab, Prop=prop.table(martab))
names(result) <- names(dimnames(dat))
> result
$vs
Freq Prop
0 18 0.5625
1 14 0.4375
$am
Freq Prop
0 19 0.59375
1 13 0.40625
$gear
Freq Prop
3 15 0.46875
4 12 0.37500
5 5 0.15625
$carb
Freq Prop
1 7 0.21875
2 10 0.31250
3 3 0.09375
4 10 0.31250
6 1 0.03125
8 1 0.03125
【讨论】：
【参考方案3】：这是使用questionr 包的freq 函数的解决方案（无耻的自动推广，抱歉）：
R> lapply(df, freq)
$vs
n %
0 18 56.2
1 14 43.8
NA 0 0.0
$am
n %
0 19 59.4
1 13 40.6
NA 0 0.0
$gear
n %
3 15 46.9
4 12 37.5
5 5 15.6
NA 0 0.0
$carb
n %
1 7 21.9
2 10 31.2
3 3 9.4
4 10 31.2
6 1 3.1
8 1 3.1
NA 0 0.0
【讨论】：
【参考方案4】：这是我的解决方案。它不漂亮，这就是为什么我在它的头上放了一个包（将它包裹在一个函数中）。我还添加了另一个变量来证明它是通用的（我希望如此）。
prettyTable <- function(x)
tbl <- apply(x, 2, function(m)
marc <- sort(unique(m))
cnt <- matrix(table(m), ncol = 1)
out <- cbind(marc, cnt)
out <- out[order(marc), ] # do sorting
out <- cbind(out, round(prop.table(out, 2)[, 2] * 100, 2))
)
x2 <- do.call("rbind", tbl)
spaces <- unlist(lapply(apply(x, 2, unique), length))
space.names <- names(spaces)
spc <- rep("", sum(spaces))
ind <- cumsum(spaces)
ind <- abs(spaces - ind)+1
spc[ind] <- space.names
out <- cbind(spc, x2)
out <- as.data.frame(out)
names(out) <- c("Variable", "Levels", "Count", "Column N %")
out
prettyTable(x = mtcars[, c(2, 8:11)])
Variable Levels Count Column N %
1 cyl 4 11 34.38
2 6 7 21.88
3 8 14 43.75
4 vs 0 18 56.25
5 1 14 43.75
6 am 0 19 59.38
7 1 13 40.62
8 gear 3 15 46.88
9 4 12 37.5
10 5 5 15.62
11 carb 1 7 21.88
12 2 10 31.25
13 3 3 9.38
14 4 10 31.25
15 6 1 3.12
16 8 1 3.12
使用googleVis包，你可以制作一个方便的html表格。
plot(gvisTable(prettyTable(x = mtcars[, c(2, 8:11)])))
【讨论】：
很好，不过对于空间来说，这样做可能更容易ifelse(duplicated(x),"",x)【参考方案5】：
使用lapply() 和do.call() 和rbind() 将各个部分拼接在一起的基本R 解决方案：
x <- lapply(mtcars[, c("vs", "am", "gear", "carb")], table)
neat.table <- function(x, name)
xx <- data.frame(x)
names(xx) <- c("Value", "Count")
xx$Fraction <- with(xx, Count/sum(Count))
data.frame(Variable = name, xx)
do.call(rbind, lapply(seq_along(x), function(i)neat.table(x[i], names(x[i]))))
结果：
Variable Value Count Fraction
1 vs 0 18 0.56250
2 vs 1 14 0.43750
3 am 0 19 0.59375
4 am 1 13 0.40625
5 gear 3 15 0.46875
6 gear 4 12 0.37500
7 gear 5 5 0.15625
8 carb 1 7 0.21875
9 carb 2 10 0.31250
10 carb 3 3 0.09375
11 carb 4 10 0.31250
12 carb 6 1 0.03125
13 carb 8 1 0.03125
剩下的就是格式化了。
【讨论】：
【参考方案6】：一种获取输出的方法，但不是格式：
library(plyr)
ldply(mtcars[,8:11],function(x) t(rbind(names(table(x)),table(x),paste0(prop.table(table(x))*100,"%"))))
.id 1 2 3
1 vs 0 18 56.25%
2 vs 1 14 43.75%
3 am 0 19 59.375%
4 am 1 13 40.625%
5 gear 3 15 46.875%
6 gear 4 12 37.5%
7 gear 5 5 15.625%
8 carb 1 7 21.875%
9 carb 2 10 31.25%
10 carb 3 3 9.375%
11 carb 4 10 31.25%
12 carb 6 1 3.125%
13 carb 8 1 3.125%
【讨论】：
以上是关于创建不同长度的分类变量的汇总表的主要内容，如果未能解决你的问题，请参考以下文章