随着时间的推移聚合和价值差异

时间:2018-09-07 09:11:06

标签: r dplyr data.table aggregation

我有一个按时间顺序排列的data.frame,如下所示:

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

如何通过以下规则汇总value列:

  1. 从第一行开始,然后逐行
  2. 检查下一条记录的时间戳,如果是30分钟内且价格差为<= 1 USD(两个条件都应用于当前存储桶中的第一条记录),则
  3. 在当前存储桶中第一行的所有行上运行cumsum(value),直到a)30分钟或b)价格差> 1 USD为止
  4. 转到下一行,然后按照1到3
  5. 如果违反条件,请启动下一个存储桶

结果data.frame应该汇总:

  • 总和(值)第1 + 2行(在30分钟内,价格差异<= 1)
  • 离开第3行(与第1行的时间差> 30分钟)
  • 从第3行开始新的存储桶,然后离开第3行(到第5行的时间差在30分钟内,但价格差 移至第4行> 1)
  • 求和(值)第4和第5行
  • 离开第6行
  • 求和(值)第7和8行
  • 离开第9行
  • 离开第10行
  • 离开第11行

结果data.frame:

53736   row 1+2
64645   row 3
663426  row 4+5
1313313 row 6
4848    row 7+8
6476    row 9
11313   row 10
9875        row 11




time_diff; price_diff
true; true  -> aggregate
true; false -> leave
false; true -> leave
false; false -> leave

谢谢!

更新:

另一个示例data.frame

    d1 <- data.frame(date = as.POSIXct(c("2010-02-09 14:05:45", "2010-02-09 14:05:52",
"2010-02-09 14:37:31", "2010-02-09 14:43:37", "2010-02-09 14:44:15", "2010-02-09 15:10:37", 
"2010-02-09 15:10:44", "2010-02-09 15:12:29", "2010-02-09 15:13:48", "2010-02-09 15:21:53", 
"2010-02-09 15:33:40", "2010-02-09 15:33:46", "2010-02-09 15:42:26", "2010-02-09 15:42:38", 
"2010-02-13 11:06:31", "2010-03-16 15:48:42", "2010-03-19 08:23:01", "2010-03-19 11:29:58", 
"2010-03-22 14:28:24", "2010-04-10 11:08:21"), format ="%Y-%m-%d %H:%M:%S"),
value = c(1074, 1075, 1500, 3000, 3000, 2500, 2500, 1000, 1000, 1000, 
1000, 1000, 1000, 1000, 6000, 5000, 1000, 5000, 3500, 1000),
price = c(154.1, 154, 128.9, 131.8, 131.7, 131.7, 131.6, 131.7, 
131.8, 131.8, 129.2, 129.2, 127.8, 127.7, 120.9, 29.1, 29, 35.6, 69.8, 11.6))

预期结果:

row 1+2
row 3
row 4 to 8
row 9+10
row 11+12
row 13+14
row 15
row 16
row 17
row 18
row 19
row 20

更新2 对于其他数据集,我写了一个For Loop,它逐行进行。这不是一个优雅的解决方案,但它似乎可以工作。 而且我认为最后一行仍然有问题(我正在For循环的开头对其进行硬编码)。

## init of an empty list
ids_in_current_backet <- list()

## loop row by roe
for (cur_row in seq(1, nrow(d1), 1)) {

  # if it is last row, break the for loop
  if(cur_row == nrow(d1)){
    d1$ids_in_current_backet[[cur_row]] <- list(nrow(d1))
    break}
  # collect ids in the current bucket
  ids_in_current_backet <- c(ids_in_current_backet, cur_row)

  # calc of differences
  time_diff <- (as.numeric(d1$date[[last(ids_in_current_backet)]] -  d1$date[[first(ids_in_current_backet)]], units = 'mins'))
  price_diff <- abs(d1$price[[last(ids_in_current_backet)]] - d1$price[[first(ids_in_current_backet)]])

  # conditions not met: more than 30 mins time OR price diff more than one
  if(time_diff > 30 | price_diff > 1){
    ids_in_current_backet <- list()
    ids_in_current_backet <- c(ids_in_current_backet, cur_row)
    d1$ids_in_current_backet[[cur_row]] <- ids_in_current_backet
   } 

  d1$ids_in_current_backet[[cur_row]] <- ids_in_current_backet

}

### extract the first element from the list as a grouping variable

for (cur_row in seq(1, nrow(d1), 1)) {
   d1$grouping[[cur_row]] <- d1$ids_in_current_backet[[cur_row]][[1]]
}

## sumarise value per grouping

d1 %>% group_by(grouping) %>%
  summarise(sum_value = sum(value, na.rm = T))

更新3 附加数据集

d1 <- data.frame(date = as.POSIXct(c("2009-01-18 15:55:54", "2009-01-22 10:24:49", "2009-02-15 11:17:14", "2009-02-22 14:27:03", 
                                 "2009-04-19 08:59:42", "2009-05-18 08:36:13", "2009-05-23 11:03:53", 
                                 "2009-05-24 12:02:06", "2009-05-24 12:02:22", "2009-05-30 08:35:04", 
                                 "2009-05-30 12:17:50", "2009-06-15 09:11:45", "2009-06-18 11:40:19", 
                                 "2009-06-18 13:22:06", "2009-06-25 14:09:07", "2009-06-28 09:47:09", 
                                 "2009-06-28 09:51:01", "2009-06-28 09:52:53", "2009-06-28 09:54:33", 
                                 "2009-06-28 15:21:44", "2009-06-28 15:34:10", "2009-07-02 12:10:56", 
                                 "2009-07-27 09:09:20", "2009-08-13 09:58:02"), format ="%Y-%m-%d %H:%M:%S"),
             value = c(5000, 3000, 15000, 1000, 1000, 9360, 8000, 4550, 2800, 1000, 2325, 1000, 3000, 1000, 1500, 4000, 10000, 10000, 3500, 10000, 3000, 1000, 6000, 2000),
             price = c(169.5, 153.5, 254.8, 245.7, 160.5, 105.8, 115.2, 111.2, 111.3, 164.1, 162.8, 93.5, 126, 124.2, 155, 169.3, 166.5, 168.8, 168.8, 177.5, 174.2, 166.2, 79.5, 119.5))

1 个答案:

答案 0 :(得分:0)

我使用了这种不太雅致的解决方案:

    ## init of an empty list
ids_in_current_backet <- list()

## loop row by roe
for (cur_row in seq(1, nrow(d1), 1)) {

  # if it is last row, break the for loop
  if(cur_row == nrow(d1)){
    d1$ids_in_current_backet[[cur_row]] <- list(nrow(d1))
    break}
  # collect ids in the current bucket
  ids_in_current_backet <- c(ids_in_current_backet, cur_row)

  # calc of differences
  time_diff <- (as.numeric(d1$date[[last(ids_in_current_backet)]] -  d1$date[[first(ids_in_current_backet)]], units = 'mins'))
  price_diff <- abs(d1$price[[last(ids_in_current_backet)]] - d1$price[[first(ids_in_current_backet)]])

  # conditions not met: more than 30 mins time OR price diff more than one
  if(time_diff > 30 | price_diff > 1){
    ids_in_current_backet <- list()
    ids_in_current_backet <- c(ids_in_current_backet, cur_row)
    d1$ids_in_current_backet[[cur_row]] <- ids_in_current_backet
   } 

  d1$ids_in_current_backet[[cur_row]] <- ids_in_current_backet

}

### extract the first element from the list as a grouping variable

for (cur_row in seq(1, nrow(d1), 1)) {
   d1$grouping[[cur_row]] <- d1$ids_in_current_backet[[cur_row]][[1]]
}

## sumarise value per grouping

d1 %>% group_by(grouping) %>%
  summarise(sum_value = sum(value, na.rm = T))