Grouping mỗi phút n với dplyr

Question

Tôi có một dataset chứa 10 sự kiện xảy ra tại một thời điểm nhất định vào một ngày nhất định, với giá trị tương ứng cho mỗi sự kiện:

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)) 

tôi muốn tổng hợp các kết quả mỗi 3 phút, theo định dạng khung dữ liệu chuẩn (từ "21/05/2010 00:00:00" đến "21/05/2010 23:57:00", sao cho khung dữ liệu có 480 thùng mỗi 3 phút)

Đầu tiên , Tôi tạo một khung dữ liệu chứa các thùng chứa 3 phút mỗi:

d2 <- data.frame(date = seq(as.POSIXct("2010-05-21 00:00:00"), 
          by="3 min", length.out=(1440/3))) 

Sau đó, tôi hợp nhất hai dataframes với nhau và loại bỏ NA:

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

Cuối cùng, tôi sử dụng period.apply() từ gói xts để tổng hợp các giá trị cho mỗi bin:

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

Có hiệu quả hơn cách để làm điều này? Nó không cảm thấy tối ưu.

Update # 1

tôi điều chỉnh mã của tôi sau câu trả lời của Giô-suê:

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) 

Tôi đã không biết rằng na.rm=TRUE có thể được sử dụng với period.apply(), mà bây giờ cho phép tôi bỏ qua mutate(value = ifelse(is.na(value),0,value)). Đó là một bước tiến và tôi thực sự hài lòng với cách tiếp cận xts ở đây nhưng tôi muốn biết nếu có một giải pháp tinh khiết dplyr tôi có thể sử dụng trong tình huống như vậy.

Update # 2

Sau khi cố gắng trả lời Khashaa, tôi đã có một lỗi vì múi giờ của tôi đã không được xác định. Vì vậy, tôi đã có:

> 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 

Bây giờ, sau Sys.setenv(TZ="UTC"), tất cả đều hoạt động tốt.

Answer 1

lubridate-dplyr giải pháp đẳng cấp.

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 

Nếu bạn cảm thấy thoải mái làm việc với Date (Tôi không), bạn có thể phân chia với lubridate, và thay thế việc hợp nhất cuối cùng với left_join.

Answer 2

Tôi không chắc chắn về một giải pháp dplyr, nhưng đây là một giải pháp XTS:

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) 

Cập nhật: Đây là một giải pháp XTS đó là cẩn thận hơn một chút về sắp xếp một cách chính xác các giá trị tổng hợp. Không đề xuất giải pháp trước là sai, nhưng giải pháp này dễ theo dõi và lặp lại trong các phân tích khác.

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

Gần đây, gói padr đã được phát triển cũng có thể giải quyết vấn đề này một cách rõ ràng.

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