Gruppierung alle n Minuten mit dplyr

Question

Ich habe einen Datensatz, der 10 Ereignisse zu einem bestimmten Zeitpunkt auftretenden an einem bestimmten Tag, mit den entsprechenden Wert für jedes Ereignis:

d1 <- data.frame(date = as.POSIXct(c("21/05/2010 19:59:37", "21/05/2010 08:40:30", 
          "21/05/2010 09:21:00", "21/05/2010 22:29:50", "21/05/2010 11:27:34", 
          "21/05/2010 18:25:14", "21/05/2010 15:16:01", "21/05/2010 09:41:53", 
          "21/05/2010 15:01:29", "21/05/2010 09:02:06"), format ="%d/%m/%Y %H:%M:%S"), 
       value = c(11313,42423,64645,643426,1313313,1313,3535,6476,11313,9875)) 

ich die Ergebnisse alle 3 Minuten aggregieren möchten, in einem Standarddatenrahmenformat (von "21/05/2010 00:00:00" bis "21/05/2010 23:57:00", so dass der Datenrahmen 480 Fächer von jeweils 3 Minuten hat)

Zuerst , Erzeuge ich einen Datenrahmen mit Behältern von jeweils 3 Minuten:

Dann habe ich fusionieren die beiden Datenrahmen zusammen und entfernen NAs:

library(dplyr) 
m <- merge(d1, d2, all=TRUE) %>% mutate(value = ifelse(is.na(value),0,value)) 

Schließlich verwende ich period.apply() vom xts Paket für jeden Behälter die Werte zu summieren:

library(xts) 
a <- period.apply(m$value, endpoints(m$date, "minutes", 3), sum) 

Gibt es eine effizientere Weg, dies zu tun? Es fühlt sich nicht optimal an.

Update # 1

eingestellt ich meinen Code nach Joshuas Antwort:

library(xts) 
startpoints <- function (x, on = "months", k = 1) { 
    head(endpoints(x, on, k) + 1, -1) 
} 

m <- seq(as.POSIXct("2010-05-21 00:00:00"), by="3 min", length.out=1440/3) 
x <- merge(value=xts(d1$value, d1$date), xts(,m)) 
y <- period.apply(x, c(0,startpoints(x, "minutes", 3)), sum, na.rm=TRUE) 

ich nicht bewusst war, dass na.rm=TRUE mit period.apply() verwendet werden könnte, was mir jetzt erlaubt mutate(value = ifelse(is.na(value),0,value)) zu überspringen. Es ist ein Schritt vorwärts und ich bin wirklich zufrieden mit der xts Ansatz hier, aber ich würde gerne wissen, ob es eine reinedplyr Lösung gibt, die ich in einer solchen Situation verwenden könnte.

Update # 2

Nach Khashaa Antwort versucht, ich hatte einen Fehler, da meine Zeitzone nicht angegeben wurde. Also musste ich:

> tail(d4) 
       interval sumvalue 
476 2010-05-21 23:45:00  NA 
477 2010-05-21 23:48:00  NA 
478 2010-05-21 23:51:00  NA 
479 2010-05-21 23:54:00  NA 
480 2010-05-21 23:57:00 11313 
481 2010-05-22 02:27:00 643426 
> d4[450,] 
       interval sumvalue 
450 2010-05-21 22:27:00  NA 

Jetzt, nach Sys.setenv(TZ="UTC"), es funktioniert gut.

Answer 1

lubridate-dplyr -esque Lösung.

library(lubridate) 
library(dplyr) 
d2 <- data.frame(interval = seq(ymd_hms('2010-05-21 00:00:00'), by = '3 min',length.out=(1440/3))) 
d3 <- d1 %>% 
    mutate(interval = floor_date(date, unit="hour")+minutes(floor(minute(date)/3)*3)) %>% 
    group_by(interval) %>% 
    mutate(sumvalue=sum(value)) %>% 
    select(interval,sumvalue) 
d4 <- merge(d2,d3, all=TRUE) # better if left_join is used 
tail(d4) 
#    interval sumvalue 
#475 2010-05-21 23:42:00  NA 
#476 2010-05-21 23:45:00  NA 
#477 2010-05-21 23:48:00  NA 
#478 2010-05-21 23:51:00  NA 
#479 2010-05-21 23:54:00  NA 
#480 2010-05-21 23:57:00  NA 
d4[450,] 
#    interval sumvalue 
#450 2010-05-21 22:27:00 643426 

Wenn Sie sind komfortabel arbeiten mit Date (ich bin nicht), können Sie mit lubridate, verzichtet werden und die endgültige Zusammenführung mit left_join ersetzen.

Answer 2

Ich bin über eine dplyr Lösung nicht sicher, aber hier ist eine xts Lösung:

startpoints <- function (x, on = "months", k = 1) { 
    head(endpoints(x, on, k) + 1, -1) 
} 
m3 <- seq(as.POSIXct("2010-05-21 00:00:00"), 
    by="3 min", length.out=1440/3) 
x <- merge(value=xts(d1$value, d1$date), xts(,m3)) 
y <- period.apply(x, c(0,startpoints(x, "minutes", 3)), sum, na.rm=TRUE) 

aktualisieren: Hier ist eine andere xts Lösung, die ein bisschen vorsichtiger richtig die aggregierten Werte auszurichten ist. Nicht zu empfehlen, dass die vorherige Lösung falsch war, aber diese Lösung ist leichter zu folgen und in anderen Analysen zu wiederholen.

m3 <- seq(as.POSIXct("2010-05-20 23:59:59.999"), 
    by="3 min", length.out=1440/3) 
x <- merge(value=xts(d1$value, d1$date), xts(,m3)) 
y <- period.apply(x, endpoints(x, "minutes", 3), sum, na.rm=TRUE) 
y <- align.time(y, 60*3) 

Answer 3

Vor kurzem wurde das padr Paket entwickelt, das dies auch auf eine saubere Art und Weise lösen kann.

library(lubridate) 
library(dplyr) 
library(padr) 

d1 <- data.frame(date = as.POSIXct(c("21/05/2010 19:59:37", "21/05/2010 08:40:30", 
            "21/05/2010 09:21:00", "21/05/2010 22:29:50", "21/05/2010 11:27:34", 
            "21/05/2010 18:25:14", "21/05/2010 15:16:01", "21/05/2010 09:41:53", 
            "21/05/2010 15:01:29", "21/05/2010 09:02:06"), format ="%d/%m/%Y %H:%M:%S"), 
       value = c(11313,42423,64645,643426,1313313,1313,3535,6476,11313,9875)) 

res <- d1 %>% 
    as_tibble() %>% 
    arrange(date) %>% 

    # Thicken the results to fall in 3 minute buckets 
    thicken(
    interval = '3 min', 
    start_val = as.POSIXct('2010-05-21 00:00:00'), 
    colname = "date_pad") %>% 

    # Pad the results to fill in the rest of the 3 minute buckets 
    pad(
    interval = '3 min', 
    by  = 'date_pad', 
    start_val = as.POSIXct('2010-05-21 00:00:00'), 
    end_val = as.POSIXct('2010-05-21 23:57:00')) %>% 

    select(date_pad, value) 

res 
#> # A tibble: 480 x 2 
#> date_pad   value 
#> <dttm>    <dbl> 
#> 1 2010-05-21 00:00:00 NA 
#> 2 2010-05-21 00:03:00 NA 
#> 3 2010-05-21 00:06:00 NA 
#> 4 2010-05-21 00:09:00 NA 
#> 5 2010-05-21 00:12:00 NA 
#> 6 2010-05-21 00:15:00 NA 
#> 7 2010-05-21 00:18:00 NA 
#> 8 2010-05-21 00:21:00 NA 
#> 9 2010-05-21 00:24:00 NA 
#> 10 2010-05-21 00:27:00 NA 
#> # ... with 470 more rows 

res[450,] 
#> # A tibble: 1 x 2 
#> date_pad    value 
#> <dttm>    <dbl> 
#> 1 2010-05-21 22:27:00 643426