rapply到R中的嵌套数据帧列表

时间:2013-07-31 12:57:19

标签: r list recursion dataframe apply

我有一个嵌套列表,其基本元素是数据帧,我希望递归遍历此列表以对每个数据帧进行一些计算,最后得到与输入结构相同的嵌套结果列表。我知道“rapply”正是为了这样的任务,但我遇到了一个问题,rapply实际上比我想要的更深,即它分解每个数据帧并应用于每一列(因为数据帧本身就是一个列表)在R)。

我能想到的一个解决方法是将每个数据帧转换为矩阵,但它会强制统一数据类型,所以我真的不喜欢它。我想知道是否有任何方法可以控制rapply的递归深度。任何的想法?感谢。

3 个答案:

答案 0 :(得分:7)

<强> 1。在proto中包装

创建列表结构时,尝试将数据框包装在proto对象中:

library(proto)
L <- list(a = proto(DF = BOD), b = proto(DF = BOD))
rapply(L, f = function(.) colSums(.$DF), how = "replace")

,并提供:

$a
  Time demand 
    22     89 

$b
  Time demand 
    22     89 

如果你想要进一步rapply,可以将你的函数的结果包装在一个proto对象中;

f <- function(.) proto(result = colSums(.$DF))
out <- rapply(L, f = f, how = "replace")
str(out)

,并提供:

List of 2
 $ a:proto object 
 .. $ result: Named num [1:2] 22 89 
 ..  ..- attr(*, "names")= chr [1:2] "Time" "demand" 
 $ b:proto object 
 .. $ result: Named num [1:2] 22 89 
 ..  ..- attr(*, "names")= chr [1:2] "Time" "demand" 

<强> 2。编写自己的替代方案

recurse <- function (L, f) {
    if (inherits(L, "data.frame")) f(L)
    else lapply(L, recurse, f)
}

L <- list(a = BOD, b = BOD)
recurse(L, colSums)

这给出了:

$a
  Time demand 
    22     89 

$b
  Time demand 
    22     89 

增加:第二种方法

答案 1 :(得分:2)

2020年6月更新

您现在还可以在rrapply软件包(基础rrapply的扩展版本)中使用rapplyrrapply包含一个附加参数dfaslist,如果将其设置为FALSE,则不会通过递归到其各自的列将data.frames视为类似于列表的对象:

library(rrapply)

L <- list(a = BOD, b = BOD)

## apply f to data.frames 
rrapply(L, f = colSums, dfaslist = FALSE)
#> $a
#>   Time demand 
#>     22     89 
#> 
#> $b
#>   Time demand 
#>     22     89

## apply f to individual columns of data.frames
rrapply(L, f = function(x, .xname) if(.xname == "demand") scale(x) else x)
#> $a
#>   Time     demand
#> 1    1 -1.4108974
#> 2    2 -0.9789900
#> 3    3  0.8998070
#> 4    4  0.2519460
#> 5    5  0.1655645
#> 6    7  1.0725699
#> 
#> $b
#>   Time     demand
#> 1    1 -1.4108974
#> 2    2 -0.9789900
#> 3    3  0.8998070
#> 4    4  0.2519460
#> 5    5  0.1655645
#> 6    7  1.0725699

答案 2 :(得分:0)

在特定深度处理列表计算:

recursive_lapply <- function (data, fun, depth = 1L) {
  stopifnot(inherits(data, "list"))
  stopifnot(depth >= 1)
  f <- function(data, fun, where = integer()) {
    if (length(where) == depth) {
      fun(data)
    } else {
      res <- lapply(seq_along(data), function(i) {f(data[[i]], fun, where = c(where, i))})
      names(res) <- names(data)
      res
    }
  }
  f(data, fun)
}

示例计算:

d <- list(
  A = list(a = list(
    a1 = data.table::data.table(x = 11:15, y = 10:14),
    a2 = data.table::data.table(x = 1:5, y = 0:4)
  )),
  B = list(b = list(
    b1 = data.table::data.table(x = 7, y = 8),
    b2 = data.table::data.table(x = 9, y = 10)
  ))
)

> recursive_lapply(d, function(data) data[, "z":= x + y], 3)
$A
$A$a
$A$a$a1
    x  y  z
1: 11 10 21
2: 12 11 23
3: 13 12 25
4: 14 13 27
5: 15 14 29

$A$a$a2
   x y z
1: 1 0 1
2: 2 1 3
3: 3 2 5
4: 4 3 7
5: 5 4 9

$B
$B$b
$B$b$b1
   x y  z
1: 7 8 15

$B$b$b2
   x  y  z
1: 9 10 19