使用 dplyr 每 n 分钟分组一次答案

【问题标题】：Grouping every n minutes with dplyr使用 dplyr 每 n 分钟分组一次
【发布时间】：2015-02-20 02:18:19
【问题描述】：

我有一个数据集，其中包含在给定日期的某个时间发生的 10 个事件，每个事件都有相应的值：

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

我想以标准数据帧格式（从“21/05/2010 00:00:00”到“21/05/2010 23:57:00”）每 3 分钟汇总一次结果，以便数据帧有 480 个垃圾箱，每个垃圾箱 3 分钟）

首先，我创建一个数据框，其中包含每个 3 分钟的 bin：

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

然后，我将两个数据框合并在一起并删除 NA：

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

最后，我使用 xts 包中的 period.apply() 对每个 bin 的值求和：

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

有没有更有效的方法来做到这一点？感觉不是很理想。

更新 #1

我在 Joshua 的回答之后调整了我的代码：

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)

我不知道na.rm=TRUE 可以与period.apply() 一起使用，现在我可以跳过mutate(value = ifelse(is.na(value),0,value))。这是向前迈出的一步，我实际上对这里的 xts 方法感到满意，但我想知道在这种情况下是否可以使用 pure dplyr 解决方案。

更新 #2

在尝试了 Khashaa 的回答后，我遇到了一个错误，因为我的时区没有指定。所以我有：

> 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

现在，Sys.setenv(TZ="UTC") 之后，一切正常。

【问题讨论】：

标签： r xts dplyr

【解决方案1】：

lubridate-dplyr-esque 解决方案。

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

如果你喜欢使用Date（我不喜欢），你可以省去lubridate，并用left_join替换最后的合并。

【讨论】：

有了这个解决方案，我得到了第 481 行，2010-05-22 02:27:00 为 interval，643426 为 value
我只是在一个新的会话上运行它，仍然得到相同的结果。我不明白为什么你会得到不同的结果。
@StevenBeaupré 这是时区问题。您在 OP 中调用 as.POSIXct 时没有时区，它将使用您的本地时区，但 Khashaa 使用的是 lubridate::ymd_hms，如果您未指定，则假定为 UTC。如果您在运行定义 d1 的 OP 中的代码之前调用 Sys.setenv(TZ="UTC")，您将得到与 Khashaa 相同的答案。
@GSee 是的，可以修复它。谢谢:)
@GSee，这真的很有意义。感谢您解决问题。

【解决方案2】：

如果您需要将数据分组到 n 分钟 bin 中，floor_date 函数可以允许在函数的 unit 参数中指定多个单位。例如：

library(lubridate)
x <- ymd_hms("2009-08-03 12:25:59.23")
floor_date(x, unit = "3minutes")

“2009-08-03 12:24:00 UTC”

用你的例子：

library(lubridate)
library(tidyverse)

# make complete time sequence
d2 <- data.frame(timePeriod = seq(as.POSIXct("2010-05-21 00:00:00"), 
                        by="3 min", length.out=(1440/3)))

d1 %>%
  mutate(timePeriod = floor_date(date, "3minutes")) %>%
  group_by(timePeriod) %>%
  summarise(sum = sum(value)) %>%
  right_join(d2)

【讨论】：

这太干净了！不再需要所有这些 xts 恶作剧！谢谢！
这是最优雅的解决方案恕我直言。

【解决方案3】：

我不确定 dplyr 解决方案，但这里有一个 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)

更新：这是另一个 xts 解决方案，它在正确对齐聚合值方面更加小心。并不是说之前的解决方案是错误的，但是这个解决方案更容易遵循并在其他分析中重复。

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)

【讨论】：

【解决方案4】：

最近开发了padr 包，它也可以用干净的方式解决这个问题。

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

【讨论】：