R语言 高效地按动态长度子集化列表

gr8qqesn  于 2023-04-18  发布在  其他
关注(0)|答案(2)|浏览(146)

我的数据由一个很大的不同长度的整数列表组成,我想将每个元素子集为预先指定的长度。
我的数据示例:

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组组成,循环通常太慢,因此我更喜欢更快的解决方案。
任何帮助将不胜感激。

k4aesqcs

k4aesqcs1#

我能想到的最简单的代码是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

直接通过length<-使用for循环来修改列表会更快:

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
2w2cym1i

2w2cym1i2#

您可以编写自己的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

相关问题