首页 文章

R自定义data.table函数,具有多个变量输入

提问于
浏览
3

我正在使用data.table(v 1.9.6)编写自定义聚合函数,并且很难将函数参数传递给它 . 对此有类似的问题,但没有一个涉及多个(可变)输入,似乎没有一个确定的答案,而是“小黑客” .

我想获取数据表总和并命令定义变量并在顶部创建新变量(2个步骤) . 关键的想法是一切都应该参数化,即变量总和,变量分组,变量排序依据 . 它们都可以是一个或多个变量 . 一个小例子 .

dt <- data.table(a=rep(letters[1:4], 5), 
                 b=rep(letters[5:8], 5),
                 c=rep(letters[3:6], 5),
                 x=sample(1:100, 20),
                 y=sample(1:100, 20),
                 z=sample(1:100, 20))

temp <- 
  dt[, .(x_sum = sum(x, na.rm = T),
         y_sum = sum(y, na.rm = T)),
     by = .(a, b)][order(a, b)]

temp2 <- 
  temp[, `:=` (x_sum_del = (x_sum - shift(x = x_sum, n = 1, type = "lag")),
               y_sum_del = (y_sum - shift(x = y_sum, n = 1, type = "lag")),
               x_sum_del_rel = ((x_sum - shift(x = x_sum, n = 1, type = "lag")) /
                                  (shift(x = x_sum, n = 1, type = "lag"))),
               y_sum_del_rel = ((y_sum - shift(x = y_sum, n = 1, type = "lag")) /
                                  (shift(x = y_sum, n = 1, type = "lag")))
               )
       ]

如何以编程方式传递以下函数参数(即不是单个输入,而是向量/输入列表):

  • x和y - > var_list

  • x和y的新名称(例如x_sum,y_sum) - > var_name_list

  • 分组参数a,b - > by_var_list

  • 按参数a,b - > order_var_list排序

  • temp 2应该适用于所有预定义的参数,我也在考虑使用apply函数,但又一次努力传递变量列表 .

我玩过get(),as.name(),eval(),quote()的变体,但是当我传递多个变量时,它们就不再起作用了 . 我希望问题很清楚,否则我很乐意在你认为必要的地方进行调整 . 函数调用如下所示:

fn_agg(dt, var_list, var_name_list, by_var_list, order_var_list)

2 回答

  • 2

    这是一个使用 mget 的选项,评论如下:

    fn_agg <- function(DT, var_list, var_name_list, by_var_list, order_var_list) {
    
      temp <- DT[, setNames(lapply(.SD, sum, na.rm = TRUE), var_name_list), 
                 by = by_var_list, .SDcols = var_list]
    
      setorderv(temp, order_var_list)
    
      cols1 <- paste0(var_name_list, "_del")
      cols2 <- paste0(cols1, "_rel")
    
      temp[, (cols1) := lapply(mget(var_name_list), function(x) {
        x - shift(x, n = 1, type = "lag")
      })]
    
      temp[, (cols2) := lapply(mget(var_name_list), function(x) {
        xshift <- shift(x, n = 1, type = "lag")
        (x - xshift) / xshift
      })]
    
      temp[]
    }
    
    fn_agg(dt, 
           var_list = c("x", "y"), 
           var_name_list = c("x_sum", "y_sum"), 
           by_var_list = c("a", "b"), 
           order_var_list = c("a", "b"))
    
    #   a b x_sum y_sum x_sum_del y_sum_del x_sum_del_rel y_sum_del_rel
    #1: a e   254   358        NA        NA            NA            NA
    #2: b f   246   116        -8      -242  -0.031496063    -0.6759777
    #3: c g   272   242        26       126   0.105691057     1.0862069
    #4: d h   273   194         1       -48   0.003676471    -0.1983471
    

    而不是 mget ,您也可以使用 data.table.SDcols 参数,如

    temp[, (cols1) := lapply(.SD, function(x) {
        x - shift(x, n = 1, type = "lag")
      }), .SDcols = var_name_list]
    

    此外,有可能通过避免重复计算 shift(x, n = 1, type = "lag") 来改进功能,但我只是想演示一种在函数中使用data.table的方法 .

  • 1

    看起来像是一个问题:)
    我更喜欢使用 get / mget 上的语言进行计算 .

    fn_agg = function(dt, var_list, var_name_list, by_var_list, order_var_list) {
        j_call = as.call(c(
            as.name("."),
            sapply(setNames(var_list, var_name_list), function(var) as.call(list(as.name("sum"), as.name(var), na.rm=TRUE)), simplify=FALSE)
        ))
        order_call = as.call(c(
            as.name("order"),
            lapply(order_var_list, as.name)
        ))
        j2_call = as.call(c(
            as.name(":="),
            c(
                sapply(setNames(var_name_list, paste0(var_name_list,"_del")), function(var) {
                    substitute(.var - shift(x = .var, n = 1, type = "lag"), list(.var=as.name(var)))
                }, simplify=FALSE),
                sapply(setNames(var_name_list, paste0(var_name_list,"_del_rel")), function(var) {
                    substitute((.var - shift(x = .var, n = 1, type = "lag")) / (shift(x = .var, n = 1, type = "lag")), list(.var=as.name(var)))
                }, simplify=FALSE)
            )
        ))
        dt[eval(order_call), eval(j_call), by=by_var_list
           ][, eval(j2_call)
             ][]
    }
    
    ans = fn_agg(dt, var_list=c("x","y"), var_name_list=c("x_sum","y_sum"), by_var_list=c("a","b"), order_var_list=c("a","b"))
    all.equal(temp2, ans)
    #[1] TRUE
    

    一些额外的说明:

    • 进行严格的输入验证,因为调试问题对元编程更加困难 .
      可以多次计算步骤2的

    • 优化,简单的方法是在步骤2中计算 _del ,在步骤3中计算 _del_rel .

    • 如果 order 变量始终与 by 变量相同,则可以将它们放入 keyby 参数中 .

相关问题