0

我很好奇是否有更快或更优雅的方法从这个数据集开始..

# generate some fake data
x <- mtcars[ , c( 1 , 2 , 8:11 ) ]

..并构建此表（带有整体、齿轮、圆柱和齿轮+圆柱突破）。请注意，这dcast只会创建一组突破，而不是同时创建所有突破。sodcast可用于单独创建第 1 行、第 2-4 行、第 5-7 行和第 8-15 行，但不能堆叠在一起。

   overall gear cyl 0_0_2 0_0_3 0_0_4 0_1_2    0_1_4 0_1_6 0_1_8    1_0_1 1_0_2 1_0_4 1_1_1 1_1_2
1        1   NA  NA 17.15  16.3 12.62    26 19.26667  19.7    15 20.33333  23.6  18.5  29.1  27.4
2        1   NA   4   NaN   NaN   NaN    26      NaN   NaN   NaN 21.50000  23.6   NaN  29.1  27.4
3        1   NA   6   NaN   NaN   NaN   NaN 21.00000  19.7   NaN 19.75000   NaN  18.5   NaN   NaN
4        1   NA   8 17.15  16.3 12.62   NaN 15.80000   NaN    15      NaN   NaN   NaN   NaN   NaN
5        1    3  NA 17.15  16.3 12.62   NaN      NaN   NaN   NaN 20.33333   NaN   NaN   NaN   NaN
6        1    4  NA   NaN   NaN   NaN   NaN 21.00000   NaN   NaN      NaN  23.6  18.5  29.1  25.9
7        1    5  NA   NaN   NaN   NaN    26 15.80000  19.7    15      NaN   NaN   NaN   NaN  30.4
8       NA    3   4   NaN   NaN   NaN   NaN      NaN   NaN   NaN 21.50000   NaN   NaN   NaN   NaN
9       NA    3   6   NaN   NaN   NaN   NaN      NaN   NaN   NaN 19.75000   NaN   NaN   NaN   NaN
10      NA    3   8 17.15  16.3 12.62   NaN      NaN   NaN   NaN      NaN   NaN   NaN   NaN   NaN
11      NA    4   4   NaN   NaN   NaN   NaN      NaN   NaN   NaN      NaN  23.6   NaN  29.1  25.9
12      NA    4   6   NaN   NaN   NaN   NaN 21.00000   NaN   NaN      NaN   NaN  18.5   NaN   NaN
13      NA    5   4   NaN   NaN   NaN    26      NaN   NaN   NaN      NaN   NaN   NaN   NaN  30.4
14      NA    5   6   NaN   NaN   NaN   NaN      NaN  19.7   NaN      NaN   NaN   NaN   NaN   NaN
15      NA    5   8   NaN   NaN   NaN   NaN 15.80000   NaN    15      NaN   NaN   NaN   NaN   NaN

这是我的解决方案，但我想知道如果没有我庞大的函数定义，是否有更聪明的方法来做这样的事情。谢谢！

# program start
library(reshape2)
library(plyr)

# load your real data here
x$overall <- 1

# define a make-table function that quickly creates overall, cyl, gear, and gear+cyl-level tables using any value and any function
mt <-
    function( x , fun , var ){
        out <-
            rbind.fill(
                dcast( x , overall ~ vs + am + carb , fun , value.var = var ) ,
                dcast( x , overall + cyl ~ vs + am + carb , fun , value.var = var ) ,
                dcast( x , gear + overall ~ vs + am + carb , fun , value.var = var ) ,
                dcast( x , gear + cyl ~ vs + am + carb , fun , value.var = var )
            )

        nsm <- c( 'overall' , 'gear' , 'cyl' )

        out[ , c( 'overall' , 'gear' , 'cyl' , names( out )[ !( names( out ) %in% nsm ) ] ) ]
    }

    # make a table of the defined structure, calculating the mean of the mpg column
mt( x , mean , 'mpg' )
4

2 回答 2

2

感谢@hadley 正是我想要的

x <- mtcars[ , c( 1 , 2 , 8:11 ) ]
library(reshape2)

y <- add_margins( x , vars = c( 'gear' , 'cyl' ) )
dcast( y , gear + cyl ~ vs + am + carb , mean , value.var = 'mpg' )
于 2013-04-02T14:32:40.350 回答
1

这是您的代码的更通用版本：

mt <- function(data, y, x, fun, var) {
  formulas <- paste(y, "~", x)
  casts    <- lapply(formulas, dcast, data = data, fun.aggregate = fun,
                                      value.var = var)
  out      <- rbind.fill(casts)

  nsm <- unique(unlist(strsplit(y, '\\s?\\+\\s?')))
  out[, c(nsm, setdiff(names(out), nsm))]
}

mt(data = x,
   y    = c("overall", "overall + cyl", "gear + overall", "gear + cyl"),
   x    = "vs + am + carb",
   fun  = mean,
   var  = 'mpg')
于 2013-03-31T12:58:47.063 回答