R: Bedingte Ausfilterung Datumsbereich

Question

Angenommen, ich habe folgende Daten:

date_time   flag 
2016-04-02 08:56:06 0 
2016-04-02 14:50:24 0 
2016-04-02 14:56:27 0 
2016-04-02 14:56:27 1 
2016-04-02 18:56:29 0 
2016-04-02 18:56:44 1 
2016-04-02 18:56:45 1 
2016-04-02 19:05:52 1 

Die Logik ist dies, für jedes Mal flag als 1 gesetzt ist, ich auf der Datetime aussehen würde, und für jeden Eintrag innerhalb 5 Minuten vorher und mit flag == 0 werden entfernt. Alles andere bleibt intakt. Also folgendes ist das was ich erwarten würde:

date_time   flag 
2016-04-02 08:56:06 0 
2016-04-02 14:50:24 0 
2016-04-02 14:56:27 1 
2016-04-02 18:56:44 1 
2016-04-02 18:56:45 1 
2016-04-02 19:05:52 1 

Gibt es da eh in R zu tun?

Hinweis: Um die Daten in R zu importieren

structure(list(
    date_time = structure(c(1459612566, 1459633824, 1459634187, 1459634187, 1459648589, 1459648604, 1459648605, 1459649152), 
    class = c("POSIXct", "POSIXt"), tzone = ""), 
    flag = c(0L, 0L, 0L, 1L, 0L, 1L, 1L, 1L)), 
    .Names = c("date_time", "flag"), 
    row.names = c(NA, -8L), 
    class = "data.frame") 

Answer 1

Hier ist eine Art und Weise, die lubridate Paket verwenden, die apply Funktion und eine Funktion, die wir definieren:

library(lubridate) 
#generate the data 
dat <- structure(list(date_time = c("2016-04-02 08:56:06", "2016-04-02 14:50:24", 
            "2016-04-02 14:56:27", "2016-04-02 14:56:27", 
            "2016-04-02 18:56:29", "2016-04-02 18:56:44", 
            "2016-04-02 18:56:45", "2016-04-02 19:05:52"), 
flag = c(0L, 0L, 0L, 1L, 0L, 1L, 1L, 1L)), .Names = c("date_time", "flag"), 
class = "data.frame", row.names = c(NA, -8L)) 
#create subsets 
dat_0 <- subset(dat, flag == 0) 
dat_1 <- subset(dat, flag == 1) 

#define function to perform calculation 
calc_diff <- function(time1, time2, upper = 0, lower = -5, units = 'mins'){ 
    dtime <- as.numeric(difftime(time1, time2, units = units)) # calculate difference 
    dtime >= lower & dtime <= upper #compute logical 
} 

#apply over the rows of dat_0, checking for any times 
#within 5 and 0 minutes prior 
find_rows <- apply(dat_0, 1, 
        function(d) any(calc_diff(ymd_hms(d[1]), ymd_hms(dat_1$date_time)))) 
#bind applicable rows to dat_1 
rbind(dat_0[!find_rows,], dat_1) 

Answer 2

Ich habe ein Testdaten wie:

library(lubridate) 
library(data.table) 
dt <- data.table(date_time = Sys.time() + minutes(round(runif(1000, max = 10000))), 
       flag = rbinom(1000, size = 1, prob = .1)) 
dt <- dt[order(date_time)] 

Mit diesen Testdaten wird das, was Sie brauchen, über diesen Code erstellt. Für jede der Beobachtungen mit Flag == 1, lapply die Funktion, wo Sie weniger als 300 Sekunden Differenz AND Flag == 0 finden. Dies wird die Liste der Zeilen zu löschen geben. Der Code dann unlist und finden Sie die eindeutigen Zeilennummern entfernt werden. Die letzte Zeile entfernt die Beobachtungen.

remove <- lapply(dt[, which(flag == 1)], 
     function(x) { 
     which(dt[, date_time - dt[x, date_time]]) > -300 & 
       dt[, date_time - dt[x, date_time]]) < 0 & 
       dt[, flag] == 0)}) %>% unlist %>% unique 
dt_sub <- dt[-remove]