在列表中加入數字順序在這樣的列表

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

對速度和內存，你可以用inline來做到這一點，它應該提高速度的數量級，並且還可以避免重複調用多個函數。例如（可能需要一些類型更改爲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 

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