Subset Beobachtungen, die von mindestens 30 Minuten Zeit unterscheiden

Question

Ich habe eine data.table (~ 30 Millionen Zeilen) aus einer datetime Säule in POSIXct Format, eine id Spalte und einige andere Spalten (im Beispiel, verließen ich nur eine irrelevant Spalte x zu demonstrieren, dass es andere Spalten gibt, die beibehalten werden müssen). A dput ist am Ende des Beitrags.

head(DT) 
#    datetime   x id 
#1: 2016-04-28 16:20:18 0.02461368 1 
#2: 2016-04-28 16:41:34 0.88953932 1 
#3: 2016-04-28 16:46:07 0.31818101 1 
#4: 2016-04-28 17:00:56 0.14711365 1 
#5: 2016-04-28 17:09:11 0.54406602 1 
#6: 2016-04-28 17:39:09 0.69280341 1 

Q: Für jeden id, ich brauche nur die Beobachtungen der Teilmenge, die von mehr als 30 Minuten Zeit abweichen. Was könnte ein effizienter data.table Ansatz sein, um dies zu tun (wenn möglich, ohne umfangreiche Schleifen)?

Die Logik kann auch als (wie in meinem Kommentar unten) beschrieben werden:

Per-ID die erste Zeile immer gehalten wird. Die nächste Reihe, die mindestens 30 Minuten nach dem ersten ist, soll auch behalten werden. Nehmen wir an, dass Zeile gehalten werden soll Zeile 4. Dann wird die Zeitunterschiede zwischen Zeile 4 und Reihen 5 berechnen: n und halten Sie die erste, die von mehr als 30 Minuten und so auf

Im dput unterscheidet unten fügte ich eine Spalte keep hinzu, um anzugeben, welche Zeilen in diesem Beispiel beibehalten werden sollten, da sie sich um mehr als 30 Minuten von der vorherigen Beobachtung unterscheiden, die pro ID beibehalten wird. Die Schwierigkeit besteht darin, dass es notwendig erscheint, die Zeitunterschiede iterativ zu berechnen (oder zumindest kann ich mir im Moment keinen effizienteren Ansatz vorstellen).

library(data.table) 
DT <- structure(list(
    datetime = structure(c(1461853218.81561, 1461854494.81561, 
    1461854767.81561, 1461855656.81561, 1461856151.81561, 1461857949.81561, 
    1461858601.81561, 1461858706.81561, 1461859078.81561, 1461859103.81561, 
    1461852799.81561, 1461852824.81561, 1461854204.81561, 1461855331.81561, 
    1461855633.81561, 1461856311.81561, 1461856454.81561, 1461857177.81561, 
    1461858662.81561, 1461858996.81561), class = c("POSIXct", "POSIXt")), 
    x = c(0.0246136845089495, 0.889539316063747, 0.318181007634848, 
    0.147113647311926, 0.544066024711356, 0.6928034061566, 0.994269776623696, 
    0.477795971091837, 0.231625785352662, 0.963024232536554, 0.216407935833558, 
    0.708530468167737, 0.758459537522867, 0.640506813768297, 0.902299045119435, 
    0.28915973729454, 0.795467417687178, 0.690705278422683, 0.59414202044718, 
    0.655705799115822), 
    id = c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L), 
    keep = c(TRUE, FALSE, FALSE, TRUE, FALSE, TRUE, FALSE, FALSE, FALSE, FALSE, TRUE, FALSE, 
      FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE, TRUE)), 
    .Names = c("datetime", "x", "id", "keep"), 
    row.names = c(NA, -20L), 
    class = c("data.table", "data.frame")) 

setkey(DT, id, datetime) 
DT[, difftime := difftime(datetime, shift(datetime, 1L, NA,type="lag"), units = "mins"), 
    by = id] 
DT[is.na(difftime), difftime := 0] 
DT[, difftime := cumsum(as.numeric(difftime)), by = id] 

Erläuterung der keep Säule:

• Zeilen 2: 3 von weniger als 30 Minuten von der Reihe unterscheiden 1 ->
• Row 4 unterscheidet sich von der Reihe von mehr als 30 Minuten löschen 1 - halten>
• Reihe 5 dufferes von weniger als 30 Minuten von Zeile 4 ->
• Row 6 unterscheidet sich von der Reihe von mehr als 30 Minuten löschen 4 -> halten
• ...

gewünschte Ausgabe:

desiredDT <- DT[(keep)] 

---

Danke für drei Experten-Antworten, die ich erhielt. Ich habe sie an 1 und 10 Millionen Datenzeilen getestet. Hier ein Auszug der Benchmarks.

a) 1 Million Zeilen

microbenchmark(frank(DT_Frank), roland(DT_Roland), eddi1(DT_Eddi1), eddi2(DT_Eddi2), 
       times = 3L, unit = "relative") 
#Unit: relative 
#    expr  min  lq  mean median  uq  max neval 
# frank(DT_Frank) 1.286647 1.277104 1.185216 1.267769 1.140614 1.036749  3 
# roland(DT_Roland) 1.000000 1.000000 1.000000 1.000000 1.000000 1.000000  3 
# eddi1(DT_Eddi1) 11.748622 11.697409 10.941792 11.647320 10.587002 9.720901  3 
# eddi2(DT_Eddi2) 9.966078 9.915651 9.210168 9.866330 8.877769 8.070281  3 

b) 10 Millionen Zeilen

microbenchmark(frank(DT_Frank), roland(DT_Roland), eddi1(DT_Eddi1), eddi2(DT_Eddi2), 
       times = 3L, unit = "relative") 
#Unit: relative 
#    expr  min  lq  mean median  uq  max neval 
# frank(DT_Frank) 1.019561 1.025427 1.026681 1.031061 1.030028 1.029037  3 
# roland(DT_Roland) 1.000000 1.000000 1.000000 1.000000 1.000000 1.000000  3 
# eddi1(DT_Eddi1) 11.567302 11.443146 11.301487 11.323914 11.176515 11.035143  3 
# eddi2(DT_Eddi2) 9.796800 9.693823 9.526193 9.594931 9.398969 9.211019  3 

Offenbar @ data.table Ansatz Frank und @ Roland RCPP basierte Lösung ähnlich sind, in der Leistung mit RCPP ein mit leichter Vorteil, während @ eddi Ansätze waren immer noch schnell, aber nicht so leistungsfähig wie die anderen.

Allerdings, wenn ich für die Gleichstellung der Lösungen geprüft, fand ich, dass @ Roland Ansatz hat ein etwas anderes Ergebnis als die anderen:

a) 1 Million Zeilen

all.equal(frank(DT_Frank), roland(DT_Roland)) 
#[1] "Component “datetime”: Numeric: lengths (982228, 982224) differ" 
#[2] "Component “id”: Numeric: lengths (982228, 982224) differ"  
#[3] "Component “x”: Numeric: lengths (982228, 982224) differ" 
all.equal(frank(DT_Frank), eddi1(DT_Eddi1)) 
#[1] TRUE 
all.equal(frank(DT_Frank), eddi2(DT_Eddi2)) 
#[1] TRUE 

b) 10 Millionen

Reihen

all.equal(frank(DT_Frank), roland(DT_Roland)) 
#[1] "Component “datetime”: Numeric: lengths (9981898, 9981891) differ" 
#[2] "Component “id”: Numeric: lengths (9981898, 9981891) differ"  
#[3] "Component “x”: Numeric: lengths (9981898, 9981891) differ"  
all.equal(frank(DT_Frank), eddi1(DT_Eddi1)) 
#[1] TRUE 
all.equal(frank(DT_Frank), eddi2(DT_Eddi2)) 
#[1] TRUE 

Meine heutige Annahme ist, dass dieser Unterschied in Zusammenhang stehen könnte, ob die differnce> 30 Minuten oder> = 30 Minuten, obwohl ich darüber noch nicht sicher bin.

Schlussgedanke: Ich entschied mich aus zwei Gründen mit der Lösung von Frank zu gehen: 1. Es funktioniert sehr gut, fast gleich mit der Rcpp-Lösung, und 2. Es braucht kein anderes Paket, mit dem ich nicht sehr bin doch vertraut (ich verwende data.table sowieso)

Answer 1

Hier ist, was ich tun würde:

setDT(DT, key=c("id","datetime")) # invalid selfref with the OP's example data 

s = 0L 
w = DT[, .I[1L], by=id]$V1 

while (length(w)){ 
    s = s + 1L 
    DT[w, tag := s] 

    m = DT[w, .(id, datetime = datetime+30*60)] 
    w = DT[m, which = TRUE, roll=-Inf] 
    w = w[!is.na(w)] 
} 

die

gibt

   datetime   x id keep tag 
1: 2016-04-28 10:20:18 0.02461368 1 TRUE 1 
2: 2016-04-28 10:41:34 0.88953932 1 FALSE NA 
3: 2016-04-28 10:46:07 0.31818101 1 FALSE NA 
4: 2016-04-28 11:00:56 0.14711365 1 TRUE 2 
5: 2016-04-28 11:09:11 0.54406602 1 FALSE NA 
6: 2016-04-28 11:39:09 0.69280341 1 TRUE 3 
7: 2016-04-28 11:50:01 0.99426978 1 FALSE NA 
8: 2016-04-28 11:51:46 0.47779597 1 FALSE NA 
9: 2016-04-28 11:57:58 0.23162579 1 FALSE NA 
10: 2016-04-28 11:58:23 0.96302423 1 FALSE NA 
11: 2016-04-28 10:13:19 0.21640794 2 TRUE 1 
12: 2016-04-28 10:13:44 0.70853047 2 FALSE NA 
13: 2016-04-28 10:36:44 0.75845954 2 FALSE NA 
14: 2016-04-28 10:55:31 0.64050681 2 TRUE 2 
15: 2016-04-28 11:00:33 0.90229905 2 FALSE NA 
16: 2016-04-28 11:11:51 0.28915974 2 FALSE NA 
17: 2016-04-28 11:14:14 0.79546742 2 FALSE NA 
18: 2016-04-28 11:26:17 0.69070528 2 TRUE 3 
19: 2016-04-28 11:51:02 0.59414202 2 FALSE NA 
20: 2016-04-28 11:56:36 0.65570580 2 TRUE 4 

die Idee dahinter durch den OP 0.123.700 beschrieben wird:

pro ID wird die erste Zeile immer beibehalten. Die nächste Reihe, die mindestens 30 Minuten nach der ersten liegt, muss ebenfalls aufbewahrt werden. Lassen Sie uns diese Zeile übernehmen gehalten werden soll Zeile 4. Dann wird die Zeitdifferenzen zwischen Zeile 4 und Zeilen berechnen 5: n und halten Sie die erste, die auf

von mehr als 30 Minuten und so unterscheidet

Answer 2

Mit RCPP:

library(Rcpp) 
library(inline) 
cppFunction(
    'LogicalVector selecttimes(const NumericVector x) { 
    const int n = x.length(); 
    LogicalVector res(n); 
    res(0) = true; 
    double testval = x(0); 
    for (int i=1; i<n; i++) { 
    if (x(i) - testval > 30 * 60) { 
     testval = x(i); 
     res(i) = true; 
    } 
    } 
    return res; 
    }') 

DT[, keep1 := selecttimes(datetime), by = id] 

DT[, all(keep == keep1)] 
#[1] TRUE 

Einige zusätzliche Tests sollten durchgeführt werden, es muss die Eingabe validiert werden, und der Zeitunterschied könnte zu einem Parameter gemacht werden.

Answer 3

# create an index column 
DT[, idx := 1:.N, by = id] 

# find the indices of the matching future dates 
DT[, fut.idx := DT[.(id = id, datetime = datetime+30*60), on = c('id', 'datetime') 
        , idx, roll = -Inf]] 
#    datetime   x id keep   difftime idx fut.idx 
# 1: 2016-04-28 09:20:18 0.02461368 1 TRUE 0.0000000 mins 1  4 
# 2: 2016-04-28 09:41:34 0.88953932 1 FALSE 21.2666667 mins 2  6 
# 3: 2016-04-28 09:46:07 0.31818101 1 FALSE 25.8166667 mins 3  6 
# 4: 2016-04-28 10:00:56 0.14711365 1 TRUE 40.6333333 mins 4  6 
# 5: 2016-04-28 10:09:11 0.54406602 1 FALSE 48.8833333 mins 5  7 
# 6: 2016-04-28 10:39:09 0.69280341 1 TRUE 78.8500000 mins 6  NA 
# 7: 2016-04-28 10:50:01 0.99426978 1 FALSE 89.7166667 mins 7  NA 
# 8: 2016-04-28 10:51:46 0.47779597 1 FALSE 91.4666667 mins 8  NA 
# 9: 2016-04-28 10:57:58 0.23162579 1 FALSE 97.6666667 mins 9  NA 
#10: 2016-04-28 10:58:23 0.96302423 1 FALSE 98.0833333 mins 10  NA 
#11: 2016-04-28 09:13:19 0.21640794 2 TRUE 0.0000000 mins 1  4 
#12: 2016-04-28 09:13:44 0.70853047 2 FALSE 0.4166667 mins 2  4 
#13: 2016-04-28 09:36:44 0.75845954 2 FALSE 23.4166667 mins 3  6 
#14: 2016-04-28 09:55:31 0.64050681 2 TRUE 42.2000000 mins 4  8 
#15: 2016-04-28 10:00:33 0.90229905 2 FALSE 47.2333333 mins 5  9 
#16: 2016-04-28 10:11:51 0.28915974 2 FALSE 58.5333333 mins 6  9 
#17: 2016-04-28 10:14:14 0.79546742 2 FALSE 60.9166667 mins 7  9 
#18: 2016-04-28 10:26:17 0.69070528 2 TRUE 72.9666667 mins 8  10 
#19: 2016-04-28 10:51:02 0.59414202 2 FALSE 97.7166667 mins 9  NA 
#20: 2016-04-28 10:56:36 0.65570580 2 TRUE 103.2833333 mins 10  NA 


# at this point the problem is "solved", but you still have to extract the solution 
# and that's the more complicated part 
DT[, keep.new := FALSE] 

# iterate over the matching indices (jumping straight to the correct one) 
DT[, { 
     next.idx = 1 

     while(!is.na(next.idx)) { 
     set(DT, .I[next.idx], 'keep.new', TRUE) 
     next.idx = fut.idx[next.idx] 
     } 
    }, by = id] 

DT[, identical(keep, keep.new)] 
#[1] TRUE 

Alternativ zum letzten Schritt, die Sie tun können (dies wird über die ganze Sache durchlaufen, aber ich weiß nicht, was die Geschwindigkeit Auswirkungen wären):

DT[, keep.3 := FALSE] 
DT[DT[, .I[na.omit(Reduce(function(x, y) fut.idx[x], c(1, fut.idx), accumulate = T))] 
     , by = id]$V1 
    , keep.3 := TRUE] 

DT[, identical(keep, keep.3)] 
#[1] TRUE