Gruppieren der Untervektoren eines Vektors

Question

Ich versuche, eine schnelle Funktion zu programmieren, die als ein Vektor v, und zwei Positionen left und right nimmt. Dann sollte die Funktion die Summe aller Untervektoren von v zurückgeben, die sowohl left als auch right enthalten.

Zum Beispiel, wenn v = c(v_1, v_2, v_3, v_4, v_5) und left = 2, right = 4, dann sind die Subvektoren, die sowohl v_2 und v_4 enthalten sind:

c(v_1, v_2, v_3, v_4) 
c(v_1, v_2, v_3, v_4, v_5) 
c(v_2, v_3, v_4) 
c(v_2, v_3, v_4, v_5) 

Insbesondere v_2, v_3, v_4 werden immer von diesen Sets enthalten. Schließlich möchte ich eine Funktion, die

S(v, 2, 4) = c(sum(v[1:4]), sum(v[1:5]), sum(v[2:4]), sum(v[2:5])) 

Meine aktuelle Lösung gibt v in eine obere Dreiecksmatrix zu machen ist:

set.seed(1) 
v <- rnorm(1:5) 
vmat <- matrix(0, 5, 5) 
for(i in 1:nrow(vmat)) for(j in i:nrow(vmat)) vmat[i,j] <- sum(v[i:j]) 

Darüber hinaus gibt es effizientere Wege, um diese Matrix zu erstellen, die here verglichen werden.

Und dann

Smat <-function(vmat, left, right) vmat[1:left, right:nrow(vmat)] 

gibt die korrekten Summen.

Da diese Operation muss oft für verschiedene v Vektoren passieren, ich bin interessiert, wenn ich dies auf eine intelligentere Weise programmieren kann. Ich finde, dass die aktuelle Implementierung suboptimal ist, weil ich für jeden Vektor eine Matrix zuordnen muss, von der ich nur das obere Dreieck verwende.

Answer 1

Wie wäre es damit?

subvector_sum <- function(v, start, end){ 
    v_list <- c(
    lapply(1:start, 
      FUN = function(i, end) i:end, 
      end), 
    lapply(end:length(v), 
      FUN = function(i, start) start:i, 
      start) 
) 

    v_list <- c(unique(v_list), list(seq_along(v))) 

    vapply(v_list, function(index) sum(v[index]), numeric(1)) 
} 

set.seed(1) 
v <- rnorm(5) 
subvector_sum(v, 2, 4) 

Zum Vergleich hier sind Benchmarks der beiden Ansätze, wenn sie auf Vektoren der Länge 5 laufen, 100 und 1000.

library(microbenchmark) 

subvector_matrix <- function(v, left, right){ 
    vmat <- matrix(0, length(v), length(v)) 
    for(i in 1:nrow(vmat)) for(j in i:nrow(vmat)) vmat[i,j] <- sum(v[i:j]) 
    vmat[1:left, right:nrow(vmat)] 
} 

set.seed(1) 
v5 <- rnorm(5) 
v100 <- rnorm(100) 
v1000 <- rnorm(1000) 

microbenchmark(
    apply5 = subvector_sum(v5, 2, 4), 
    matrix5 = subvector_matrix(v5, 2, 4), 
    apply100 = subvector_sum(v100, 2, 4), 
    matrix100 = subvector_matrix(v100, 2, 4), 
    apply1000 = subvector_sum(v1000, 2, 4) 
) 

Unit: microseconds 
     expr  min   lq  mean median   uq  max neval 
    apply5 21.700 26.5390 43.54169 30.938 60.2630 84.456 100 
    matrix5 29.618 38.1225 47.03129 46.480 55.1310 73.312 100 
    apply100 229.026 255.1260 274.39212 273.600 292.5145 351.018 100 
matrix100 10273.639 10596.3570 11894.37717 10850.604 13593.2015 15193.747 100 
apply1000 5371.710 5520.0945 6305.76903 5663.346 5886.3600 13557.719 100 

Wie Sie sehen können, die apply Ansatz Ich habe Läufe vorgeschlagen schneller auf einem Vektor der Länge 1000 als Ihre Matrix-Ansatz auf einem Vektor der Länge 100. Ich wollte nicht warten, um zu sehen, wie lange es dauern würde, um die Matrix auf einem Vektor der Länge 1000 zu tun, so dass es hier weggelassen wird.