запрессовки номера в списках последовательно

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