有效地按动态长度子集列表

Question

我的数据由大量不同长度的整数组成，我想将每个元素子集化为预先指定的长度。

我的数据示例：

my_list <- list(c(-4L, -2L), c(4L, 6L, 9L, -4L, 10L, 2L, -3L, 8L), c(-1L, 
                                                          1L), c(-4L, -5L, 5L, -2L, 4L, 10L, 7L), c(-2L, 10L, 3L, -3L, 
                                                                                                    8L, -1L, 7L, 4L, 0L, 2L))

我事先知道最终长度，并且想根据这些计算出的长度从本质上选择每个列表元素的前 n 个数字。

假设这些最终长度是：

sizes <- c(1, 7, 0, 5, 8)

这意味着输出应该如下所示：

[[1]]
[1] -4

[[2]]
[1]  4  6  9 -4 10  2 -3

[[3]]
integer(0)

[[4]]
[1] -4 -5  5 -2  4

[[5]]
[1] -2 10  3 -3  8 -1  7  4

由于我的真实数据由 > 500k 组组成，循环通常太慢，因此我更喜欢更快的解决方案。

任何帮助将不胜感激。

Answer 1

我能想到的最简单的代码是

Map

数据和大小，并通过

head

进行子集：

my_list2 <- rep(my_list, 1e5)
sizes2 <- rep(sizes, 1e5)

system.time({Map(head, my_list2, sizes2)})
##   user  system elapsed 
##   2.81    0.19    3.00

在相同的方法中使用直接子集可以将速度提高 4 倍：

system.time(Map(\(l,s) if(s == 0) l[0] else l[1:s], my_list2, sizes2))
##   user  system elapsed 
##   0.69    0.00    0.69 

使用 for 循环通过

length<-

直接就地更改列表再次更快：

system.time({
    for(i in seq_along(my_list2)) {
        length(my_list2[[i]]) <- sizes2[i]
    }
})
##   user  system elapsed 
##   0.16    0.02    0.18

循环也返回与

Map

选项相同的结果：

identical(my_list2, Map(head, my_list2, sizes2))
##[1] TRUE

Answer 2

您可以编写自己的 C / C++ 实现以稍微提高速度。

这是一种方法。在您的 sizes 对象中有

0

的地方，我正在创建一个空向量，而不是将列表元素保留为 NULL，因为这与您的预期输出一致。

这也没有错误检查（索引超出范围等）。它假设您的所有输入都已清理。

library(Rcpp)

cppFunction(
  
  code = "
  Rcpp::List list_subset(Rcpp::List my_list, Rcpp::IntegerVector sizes) {
    R_xlen_t n = sizes.length();
    R_xlen_t i;
    
    Rcpp::List res(n);
    
    for(i = 0; i < n; ++i ) {
      Rcpp::IntegerVector int_vec = Rcpp::Vector< INTSXP >(my_list[i]);
      int end_range = sizes[i];
      if( end_range > 0 ) {
        res[i] = int_vec[ Rcpp::Range(0, end_range - 1 ) ]; 
      } else {
        Rcpp::IntegerVector empty_vec(0);
        res[i] = empty_vec;
      }
    }
    
    return res;
  }
  "
)


## Benchmarking

my_list2 <- rep(my_list, 1e5)
sizes2 <- rep(sizes, 1e5)


loop <- function(list, sizes) {
  
  for(i in seq_along(list)) {
    length(list[[i]]) <- sizes[i]
  }
  return( list )
}

microbenchmark::microbenchmark(
  
  rcpp = { list_subset(my_list = my_list2, sizes = sizes2) },
  
  loop = { loop(my_list2, sizes = sizes2) },
  
  times = 5
)

# Unit: milliseconds
#  expr      min       lq     mean   median        uq       max neval
#  rcpp 44.79767 45.13387 49.50189 46.49572  52.65503  58.42717     5
#  loop 67.35541 67.35808 88.13320 77.38955 104.78837 123.77457     5

identical(loop(my_list2, sizes2), list_subset(my_list2, sizes2))
# TRUE