Gruppenvektor auf bedingter Summe

Question

Ich möchte einen Vektor basierend auf der Summe der Elemente gruppieren, die kleiner oder gleich n sind. Nehmen wir die folgende,

set.seed(1) 
x <- sample(10, 20, replace = TRUE) 
#[1] 3 4 6 10 3 9 10 7 7 1 3 2 7 4 8 5 8 10 4 8 

#Where, 
n = 15 

Die erwartete Ausgabe Gruppenwerte sein würde, während ihre Summe < ist = 15, dh

y <- c(1, 1, 1, 2, 2, 3, 4, 5 ,5, 5, 6, 6, 6, 7, 7, 8, 8, 9, 9, 10) 

Wie Sie die Summe sehen kann, ist nie größer als 15 ist,

sapply(split(x, y), sum) 
# 1 2 3 4 5 6 7 8 9 10 
#13 13 9 10 15 12 12 13 14 8 

HINWEIS: Ich werde dies auf riesigen Datensätzen (in der Regel> 150 - 200 GB) laufen, so dass Effizienz ein Muss ist.

Eine Methode, die ich versuchte, und in der Nähe kommt, aber nicht ist,

as.integer(cut(cumsum(x), breaks = seq(0, max(cumsum(x)) + 15, 15))) 
#[1] 1 1 1 2 2 3 3 4 4 4 5 5 5 6 6 6 7 8 8 8 

Answer 1

Hier ist meine Rcpp ige Lösung (in der Nähe Khashaa's Lösung, aber ein bisschen kürzer/abgespeckte), weil Sie sagten, die Geschwindigkeit wichtig war, Rcpp ist wahrscheinlich der Weg zu gehen:

# create the data 
set.seed(1) 
x <- sample(10, 20, replace = TRUE) 
y <- c(1, 1, 1, 2, 2, 3, 4, 5 ,5, 5, 6, 6, 6, 7, 7, 8, 8, 9, 9, 10) 

# create the Rcpp function 
library(Rcpp) 
cppFunction(' 
IntegerVector sotosGroup(NumericVector x, int cutoff) { 
IntegerVector groupVec (x.size()); 
int group = 1; 
double runSum = 0; 
for (int i = 0; i < x.size(); i++) { 
    runSum += x[i]; 
    if (runSum > cutoff) { 
    group++; 
    runSum = x[i]; 
    } 
    groupVec[i] = group; 
} 
return groupVec; 
} 
') 

# use the function as usual 
y_cpp <- sotosGroup(x, 15) 
sapply(split(x, y_cpp), sum) 
#> 1 2 3 4 5 6 7 8 9 10 
#> 13 13 9 10 15 12 12 13 14 8 


all.equal(y, y_cpp) 
#> [1] TRUE 

Falls sich jemand durch die Geschwindigkeit zu überzeugen muss:

# Speed Benchmarks 
library(data.table) 
library(microbenchmark) 
dt <- data.table(x) 

frank <- function(DT, n = 15) { 
DT[, xc := cumsum(x)] 
b = DT[.(shift(xc, fill=0) + n + 1), on=.(xc), roll=-Inf, which=TRUE] 
z = 1; res = z 
while (!is.na(z)) 
    res <- c(res, z <- b[z]) 
DT[, g := cumsum(.I %in% res)][] 
} 

microbenchmark(
frank(dt), 
sotosGroup(x, 15), 
times = 100 
) 
#> Unit: microseconds 
#>    expr  min  lq  mean median  uq  max neval cld 
#>   frank(dt) 1720.589 1831.320 2148.83096 1878.0725 1981.576 13728.830 100 b 
#> sotosGroup(x, 15) 2.595 3.962 6.47038 7.5035 8.290 11.579 100 a 

Answer 2

Dies funktioniert, aber wahrscheinlich verbessert werden kann:

x <- c(3L, 4L, 6L, 10L, 3L, 9L, 10L, 7L, 7L, 1L, 3L, 2L, 7L, 4L, 8L, 5L, 8L, 10L, 4L, 8L) 
y <- as.integer(c(1, 1, 1, 2, 2, 3, 4, 5 ,5, 5, 6, 6, 6, 7, 7, 8, 8, 9, 9, 10)) 
n = 15 
library(data.table) 
DT = data.table(x,y) 
DT[, xc := cumsum(x)] 
b = DT[.(shift(xc, fill=0) + n + 1), on=.(xc), roll=-Inf, which=TRUE] 
z = 1; res = logical(length(x)) 
while (!is.na(z) && z <= length(x)){ 
    res[z] <- TRUE 
    z <- b[z] 
} 
DT[, g := cumsum(res)] 
    x y xc g 
1: 3 1 3 1 
2: 4 1 7 1 
3: 6 1 13 1 
4: 10 2 23 2 
5: 3 2 26 2 
6: 9 3 35 3 
7: 10 4 45 4 
8: 7 5 52 5 
9: 7 5 59 5 
10: 1 5 60 5 
11: 3 6 63 6 
12: 2 6 65 6 
13: 7 6 72 6 
14: 4 7 76 7 
15: 8 7 84 7 
16: 5 8 89 8 
17: 8 8 97 8 
18: 10 9 107 9 
19: 4 9 111 9 
20: 8 10 119 10 

DT[, all(y == g)] # TRUE 

Wie es

Das Walzen arbeitet Join fragt: "Wenn dies der Anfang einer Gruppe ist, wo wird der nächste beginnen?" Dann können Sie das Ergebnis von der ersten Position ausgehend iterieren, um alle Gruppen zu finden.

Die letzte Zeile DT[, g := cumsum(res)] auch als Roll beitreten getan werden könnte (vielleicht schneller?):

DT[, g := data.table(r = which(res))[, g := .I][.(.I), on=.(r), roll=TRUE, x.g ]]