创建不同长度的分类变量的汇总表

时间:2013-02-27 12:02:37

标签: r count spss summary

在SPSS中,使用“自定义表格”创建分类变量的汇总表非常容易:

This example is from SPSS

如何在R中执行此操作?

一般和可扩展的解决方案是首选,并使用的解决方案 Plyr和/或Reshape2包,因为我正在尝试学习这些。

示例数据:( mtcars在R安装中)

df <- colwise(function(x) as.factor(x) ) (mtcars[,8:11])

P.S。

请注意,我的目标是将所有内容都放在 one 表中,如图所示。 我已经玩了好几个小时,但我的尝试一直很糟糕,发布代码可能不会增加问题的可理解性。

6 个答案:

答案 0 :(得分: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%

答案 1 :(得分: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

其余的是格式化。

答案 2 :(得分: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)])))

enter image description here

答案 3 :(得分:1)

您可能会发现以下代码段非常有用。它利用基本包函数 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

答案 4 :(得分:0)

以下是使用freq软件包的questionr函数的解决方案(无耻的autopromotion,抱歉):

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

答案 5 :(得分:0)

不幸的是,似乎没有R包可以产生像SPSS这样的好输出。用于生成表的大多数函数似乎都定义了自己的特殊格式,如果您想以其他方式导出或处理它,会导致您遇到麻烦。
但我确信R能够做到这一点,所以我开始编写自己的功能。我很高兴与您分享结果(工作进展状态,但完成工作):

以下函数为data.frame中的所有因子变量返回因子变量“variable”的每个级别的频率或百分比(calc =“perc”)。
最重要的是输出是简单的&amp;用户友好的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 )    
}