Question

我在这样的列表中有数字：

$`1`
 [1]  0.000000  4.583333  6.466667 10.750000 11.166667 12.300000 12.750000 14.350000 15.016667 17.683333 18.533333 19.116667 21.966667 27.750000 31.566667 33.983333 34.700000 38.500000

$`2`
[1]  0.000000  1.383333 15.183333 23.833333 23.833333 23.833333 34.433333 35.766667 40.166667

$`3`
[1]  0.000000  9.633333 11.850000 13.416667 30.700000 53.633333 54.883333 55.116667 56.116667

$`4`
 [1]  0.000000  0.000000  1.783333  2.583333 10.933333 11.216667 14.733333 15.833333 16.033333 16.783333 17.183333 23.733333 23.733333 25.666667 33.700000 34.766667 35.616667 36.833333
[19] 38.516667 40.216667 40.750000 43.500000 45.683333 48.066667 48.283333 48.883333 49.916667 50.516667

数据：

structure(list(`1` = c(0, 4.58333333333331, 6.46666666666667, 
10.75, 11.1666666666667, 12.3, 12.75, 14.35, 15.0166666666667, 
17.6833333333333, 18.5333333333333, 19.1166666666667, 21.9666666666667, 
27.75, 31.5666666666667, 33.9833333333333, 34.7, 38.5), `2` = c(0, 
1.38333333333334, 15.1833333333333, 23.8333333333333, 23.8333333333333, 
23.8333333333333, 34.4333333333333, 35.7666666666667, 40.1666666666667
), `3` = c(0, 9.63333333333333, 11.85, 13.4166666666667, 30.7, 
53.6333333333333, 54.8833333333333, 55.1166666666667, 56.1166666666667
), `4` = c(0, 0, 1.78333333333333, 2.58333333333333, 10.9333333333333, 
11.2166666666667, 14.7333333333333, 15.8333333333333, 16.0333333333333, 
16.7833333333333, 17.1833333333333, 23.7333333333333, 23.7333333333333, 
25.6666666666667, 33.7, 34.7666666666667, 35.6166666666667, 36.8333333333333, 
38.5166666666667, 40.2166666666667, 40.75, 43.5, 45.6833333333333, 
48.0666666666667, 48.2833333333333, 48.8833333333333, 49.9166666666667, 
50.5166666666667)), .Names = c("1", "2", "3", "4"))

我想要做的是制作一个长数字向量。它们将按照它们出现在列表中的顺序加入。但是，有两个额外的要求。

首先，列表第二个元素中的数字应该添加到列表第一个元素的最后一个数字中。然后应将第三个元素中的数字添加到前两个元素中的最终数字中......依此类推。

第二个要求是需要在元素之间添加“差距”。在这个例子中，我使用了5的间隙。

这段代码有效，但是我想看看是否会有更快（也许是data.table）的方式来加速它？

library(dplyr)
gap <- 5
cumes <- lapply(vec, max) %>% unlist 
cumes <- cumes + gap      
cumes <- c(0, cumes %>% cumsum %>% as.numeric)
cumes <- cumes[-length(cumes)]

out<-NULL
for(i in 1:length(cumes)){
  out[[i]] <- vec[[i]] + cumes[i]
}

unlist(out)


[1]   0.000000   4.583333   6.466667  10.750000  11.166667  12.300000  12.750000  14.350000  15.016667  17.683333  18.533333  19.116667  21.966667  27.750000  31.566667  33.983333
[17]  34.700000  38.500000  43.500000  44.883333  58.683333  67.333333  67.333333  67.333333  77.933333  79.266667  83.666667  88.666667  98.300000 100.516667 102.083333 119.366667
[33] 142.300000 143.550000 143.783333 144.783333 149.783333 149.783333 151.566667 152.366667 160.716667 161.000000 164.516667 165.616667 165.816667 166.566667 166.966667 173.516667
[49] 173.516667 175.450000 183.483333 184.550000 185.400000 186.616667 188.300000 190.000000 190.533333 193.283333 195.466667 197.850000 198.066667 198.666667 199.700000 200.300000

Answer 1

对于速度和内存，你可以使用R_len_t执行此操作，它应该可以提高速度的数量级，并且还可以避免重复调用多个函数。例如（可能想要将某些类型更改为body <- ' SEXP res; int i, j, l, out_len = 0, len = LENGTH(lst), index=0; double g, inc = REAL(gap)[0]; for (i = 0; i < len; i++) out_len += LENGTH(VECTOR_ELT(lst, i)); PROTECT(res = allocVector(REALSXP, out_len)); double *elem, *rval = REAL(res); for (i = 0; i < len; i++) { l = LENGTH(VECTOR_ELT(lst, i)); elem = REAL(VECTOR_ELT(lst, i)), g = i > 0 ? rval[index-1] + inc : 0.0; // add the gap and prev max for (j = 0; j < l; j++) rval[index++] = elem[j] + g; } UNPROTECT(1); return res;' library(inline) cumjoin <- cfunction(signature(lst = 'list', gap = 'numeric'), body=body) microbenchmark(prev(vec, 5), myfunc(vec, 5), cumjoin(vec, 5)) # Unit: nanoseconds # expr min lq mean median uq max neval cld # prev(vec, 5) 116826 120901.5 128819.38 125127 131165 217350 100 c # myfunc(vec, 5) 45584 48301.0 53052.11 51923 53734 108676 100 b # cumjoin(vec, 5) 302 605.0 1117.80 1208 1208 10264 100 a或其他），

KV.kulu.title

Answer 2

这是一个（基础）功能，在以前的大约40％的时间内完成：

myfunc <- function(data, gaps){
  cumes <- c(0, cumsum(sapply(1:(length(data)-1), function(x) data[[x]][length(data[[x]])] + gaps)))
  unlist(mapply("+", data, cumes))
}

基准：

library(microbenchmark)
microbenchmark(
   prev = {
      cumes <- lapply(vec, max) %>% unlist 
      cumes <- cumes + gap      
      cumes <- c(0, cumes %>% cumsum %>% as.numeric)
      cumes <- cumes[-length(cumes)]
      out<-NULL
      for(i in 1:length(cumes)){
        out[[i]] <- vec[[i]] + cumes[i]
      }
      unlist(out)
  },
  new = myfunc(vec, 5))

Unit: microseconds
 expr     min       lq     mean   median       uq     max neval cld
 prev 258.818 266.8810 278.1595 275.7135 282.8175 378.626   100   b
  new 100.993 104.8335 113.3042 107.5210 115.2015 324.866   100  a

按顺序连接列表中的数字

2 个答案: