高效地移除列表及其子列表中的所有NULL值

Question

考虑以下列表：

> l1 <- list(NULL,1,2,list(NULL,3,list(NULL,4)))
> str(l1)
List of 4
 $ : NULL
 $ : num 1
 $ : num 2
 $ :List of 3
  ..$ : NULL
  ..$ : num 3
  ..$ :List of 2
  .. ..$ : NULL
  .. ..$ : num 4

要从第一层级中去除NULL值，只需调用

l1[vapply(l1,is.null,logical(1L))] <- NULL

现在我想要在所有层级上删除所有的NULL值，我想出了以下代码。

list.clean <- function(.data, fun = is.null, recursive = FALSE) {
  if(recursive) {
    .data <- lapply(.data, function(.item) {
      if(is.list(.item)) list.clean(.item, fun, TRUE)
      else .item
    })
  }
  .data[vapply(.data,fun,logical(1L))] <- NULL
  .data
}

呼叫

> list.clean(l1, recursive = TRUE)
[[1]]
[1] 1

[[2]]
[1] 2

[[3]]
[[3]][[1]]
[1] 3

[[3]][[2]]
[[3]][[2]][[1]]
[1] 4

虽然现在它能正常工作，但是否有更好或更快的方法？

- Kun Ren

---

我知道一种快速的方法，它不需要计算任何东西...虽然可能会被人不喜欢。 :) - Rich Scriven

Answer 1

这可以通过递归实现：

rmNull <- function(x) {
   x <- Filter(Negate(is.null), x)
   lapply(x, function(x) if (is.list(x)) rmNull(x) else x)
}
l2 <- rmNull(l1)

给予：

> str(l2)
List of 3
 $ : num 1
 $ : num 2
 $ :List of 2
  ..$ : num 3
  ..$ :List of 1
  .. ..$ : num 4

- G. Grothendieck

---

应该使用“Recall”来编写递归函数。这样，函数名称不会被编码进去，如果将其分配给其他名称，则不会导致出现错误。但在 *apply 函数中，“Recall”无法正常工作。因此，不要使用它。请勿阅读此评论。 - Spacedman

感谢您的解决方案。但是性能似乎无法接受：对于最多有3个级别的包含400,000个元素的列表，list.clean的成本为0.18秒，而rmNull在我的电脑上需要3.6秒。 - Kun Ren

请注意，这会给出与 list.clean 在 list(NULL,list(NULL)) 上不同的结果。 - Spacedman

如果指定了 recursive = TRUE，它将给出相同的答案。 - G. Grothendieck

这很好。一个非常具有挑战性的问题。很棒的答案。 - Rich Scriven

Answer 2

使用外部包，现在也可以使用rrapply在rrapply包中完成（这是基本rapply的修订版本）。设置how = "prune"以修剪所有不满足condition参数中定义的函数的列表元素：

library(rrapply)

l1 <- list(NULL,1,2,list(NULL,3,list(NULL,4)))

rrapply(l1, condition = Negate(is.null), how = "prune")
#> [[1]]
#> [1] 1
#> 
#> [[2]]
#> [1] 2
#> 
#> [[3]]
#> [[3]][[1]]
#> [1] 3
#> 
#> [[3]][[2]]
#> [[3]][[2]][[1]]
#> [1] 4

我们可以对大型列表对象的计算时间进行基准测试，以比较 OP 的 list.clean 函数和 G. Grothendieck 的 rmNull 函数：

## benchmark recursion functions
rmNull <- function(x) {
  x <- Filter(Negate(is.null), x)
  lapply(x, function(x) if (is.list(x)) rmNull(x) else x)
}

list.clean <- function(.data, fun = is.null, recursive = FALSE) {
  if(recursive) {
    .data <- lapply(.data, function(.item) {
      if(is.list(.item)) list.clean(.item, fun, TRUE)
      else .item
    })
  }
  .data[vapply(.data,fun,logical(1L))] <- NULL
  .data
}

## recursively create nested list with dmax layers and 50% NULL elements
f <- function(len, d, dmax) {
  x <- vector(mode = "list", length = len)
  for(i in seq_along(x)) {
    if(d + 1 < dmax) {
      x[[i]] <- Recall(len, d + 1, dmax)
    } else {
      x[[i]] <- list(1, NULL)
    }
  }
  return(x)
}

## long shallow list (3 layers, total 5e5 nodes)
x_long <- f(len = 500, d = 1, dmax = 3)

microbenchmark::microbenchmark(
  rmNull = rmNull(x_long),
  list.clean = list.clean(x_long, recursive = TRUE),
  rrapply = rrapply(x_long, condition = Negate(is.null), how = "prune"),
  check = "equal",
  times = 5L
)
#> Unit: milliseconds
#>        expr       min        lq      mean    median        uq       max
#>      rmNull 2381.5536 2535.6871 2559.4045 2546.0375 2571.9462 2761.7982
#>  list.clean 1954.4046 1973.7983 2012.2158 2010.7334 2049.8020 2072.3409
#>     rrapply  288.5784  297.9041  382.3111  301.3147  460.5107  563.2475

## deeply nested list (18 layers, total 2^18 nodes)
x_deep <- f(len = 2, d = 1, dmax = 18)

microbenchmark::microbenchmark(
  rmNull = rmNull(x_deep),
  list.clean = list.clean(x_deep, recursive = TRUE),
  rrapply = rrapply(x_deep, condition = Negate(is.null), how = "prune"),
  check = "equal",
  times = 5L
)
#> Unit: milliseconds
#>        expr       min        lq      mean    median       uq       max
#>      rmNull 2306.5788 2360.2663 2422.2578 2367.9296 2530.201 2546.3135
#>  list.clean 1708.1192 1829.1303 2014.2162 2157.2148 2180.023 2196.5937
#>     rrapply  174.5385  187.9491  271.4967  200.9263  206.739  587.3306

- Joris C.