基于 R 中两种不同的评估方法聚合数据答案

【问题标题】：Aggregate Data based on Two Different Assessment Methods in R基于 R 中两种不同的评估方法聚合数据
【发布时间】：2020-02-04 13:57:37
【问题描述】：

我希望汇总一些计步器数据，以每分钟步数为单位收集，因此我得到了在 EMA 评估之前的总步数。 EMA 评估每天进行四次。两个数据集的一个例子是：

计步器数据

ID Steps      Time
1   15   2/4/2020 8:32
1   23   2/4/2020 8:33
1   76   2/4/2020 8:34
1   32   2/4/2020 8:35
1   45   2/4/2020 8:36
...
2   16   2/4/2020 8:32
2   17   2/4/2020 8:33
2   0    2/4/2020 8:34
2   5    2/4/2020 8:35
2   8    2/4/2020 8:36

EMA 数据

ID      Time      X Y
1  2/4/2020 8:36  3 4
1  2/4/2020 12:01 3 5
1  2/4/2020 3:30  4 5
1  2/4/2020 6:45  7 8
...
2  2/4/2020 8:35  4 6
2  2/4/2020 12:05 5 7
2  2/4/2020 3:39  1 3
2  2/4/2020 6:55  8 3

我希望将计步器数据作为一个新变量添加到 EMA 数据中，在该变量中，在下一次 EMA 评估之前将所采取的步数相加。理想情况下，它会像这样：

综合数据

ID      Time      X Y Steps
1  2/4/2020 8:36  3 4 191
1  2/4/2020 12:01 3 5 [Sum of steps taken from 8:37 until 12:01 on 2/4/2020]
1  2/4/2020 3:30  4 5 [Sum of steps taken from 12:02 until 3:30 on 2/4/2020]
1  2/4/2020 6:45  7 8 [Sum of steps taken from 3:31 until 6:45 on 2/4/2020]
...
2  2/4/2020 8:35  4 6 38
2  2/4/2020 12:05 5 7 [Sum of steps taken from 8:36 until 12:05 on 2/4/2020]
2  2/4/2020 3:39  1 3 [Sum of steps taken from 12:06 until 3:39 on 2/4/2020]
2  2/4/2020 6:55  8 3 [Sum of steps taken from 3:40 until 6:55 on 2/4/2020]

然后我需要在整个 21 天 EMA 期间继续该过程，因此对于 2020 年 2 月 5 日、2020 年 2 月 6 日等 4 个 EMA 评估时间点的过程相同。

这将我的 R 技能推到了极限，所以任何指点都会非常有帮助！我最熟悉 tidyverse，但也很喜欢使用 base R。提前感谢所有建议。

【问题讨论】：

标签： r datetime aggregate tidyverse data-cleaning

【解决方案1】：

这是使用来自data.table 的滚动联接的解决方案。这里的基本思想是每次从pedometer 数据向上滚动到EMA 数据中的下一次（同时仍然匹配 ID）。一旦找到下一个 EMA 时间，剩下的就是隔离 X 和 Y 值并总结 Steps。

数据创建和准备：

library(data.table)
pedometer <- data.table(ID = sort(rep(1:2, 500)), 
                        Time = rep(seq.POSIXt(as.POSIXct("2020-02-04 09:35:00 EST"), 
                                              as.POSIXct("2020-02-08 17:00:00 EST"), length.out = 500), 2),
                        Steps = rpois(1000, 25))

EMA <- data.table(ID = sort(rep(1:2, 4*5)),
                  Time = rep(seq.POSIXt(as.POSIXct("2020-02-04 05:00:00 EST"), 
                                        as.POSIXct("2020-02-08 23:59:59 EST"), by = '6 hours'), 2),
                  X = sample(1:8, 2*4*5, rep = T),
                  Y = sample(1:8, 2*4*5, rep = T))
setkey(pedometer, Time)
setkey(EMA, Time)
EMA[,next_ema_time := Time]

现在是实际的连接和求和：

joined <- EMA[pedometer, 
              on = .(ID, Time), 
              roll = -Inf, 
              j = .(ID, Time, Steps, next_ema_time, X, Y)]
result <- joined[,.('X' = min(X),
                    'Y' = min(Y),
                    'Steps' = sum(Steps)),
                 .(ID, next_ema_time)]
result
#>     ID       next_ema_time X Y Steps
#>  1:  1 2020-02-04 11:00:00 1 2   167
#>  2:  2 2020-02-04 11:00:00 8 5   169
#>  3:  1 2020-02-04 17:00:00 3 6   740
#>  4:  2 2020-02-04 17:00:00 4 6   747
#>  5:  1 2020-02-04 23:00:00 2 2   679
#>  6:  2 2020-02-04 23:00:00 3 2   732
#>  7:  1 2020-02-05 05:00:00 7 5   720
#>  8:  2 2020-02-05 05:00:00 6 8   692
#>  9:  1 2020-02-05 11:00:00 2 4   731
#> 10:  2 2020-02-05 11:00:00 4 5   773
#> 11:  1 2020-02-05 17:00:00 1 5   757
#> 12:  2 2020-02-05 17:00:00 3 5   743
#> 13:  1 2020-02-05 23:00:00 3 8   693
#> 14:  2 2020-02-05 23:00:00 1 8   740
#> 15:  1 2020-02-06 05:00:00 8 8   710
#> 16:  2 2020-02-06 05:00:00 3 2   760
#> 17:  1 2020-02-06 11:00:00 8 4   716
#> 18:  2 2020-02-06 11:00:00 1 2   688
#> 19:  1 2020-02-06 17:00:00 5 2   738
#> 20:  2 2020-02-06 17:00:00 4 6   724
#> 21:  1 2020-02-06 23:00:00 7 8   737
#> 22:  2 2020-02-06 23:00:00 6 3   672
#> 23:  1 2020-02-07 05:00:00 2 6   726
#> 24:  2 2020-02-07 05:00:00 7 7   759
#> 25:  1 2020-02-07 11:00:00 1 4   737
#> 26:  2 2020-02-07 11:00:00 5 2   737
#> 27:  1 2020-02-07 17:00:00 3 5   766
#> 28:  2 2020-02-07 17:00:00 4 4   745
#> 29:  1 2020-02-07 23:00:00 3 3   714
#> 30:  2 2020-02-07 23:00:00 2 1   741
#> 31:  1 2020-02-08 05:00:00 4 6   751
#> 32:  2 2020-02-08 05:00:00 8 2   723
#> 33:  1 2020-02-08 11:00:00 3 3   716
#> 34:  2 2020-02-08 11:00:00 3 6   735
#> 35:  1 2020-02-08 17:00:00 1 5   696
#> 36:  2 2020-02-08 17:00:00 7 7   741
#>     ID       next_ema_time X Y Steps

^{由reprex package (v0.3.0) 于 2020 年 2 月 4 日创建}

【讨论】：

【解决方案2】：

我会 left_join ema_df pedometer_df ID 和 Time。这样你得到当不是 EMA 评估时间时，pedometer_df 的所有行都缺少 x 和 y 的值（我假设是标识符）。

我使用下一个可用值填充值（所以下一个 ema 评估 x 和 y）最后，group_by ID x 和 y 和 summarise 保持评估的日期时间（最大值）和步骤总和。

library(dplyr)
library(tidyr)

pedometer_df %>%
  left_join(ema_df, by = c("ID", "Time")) %>%
  fill(x, y, .direction = "up") %>%
  group_by(ID, x, y) %>%
  summarise(
    Time = max(Time),
    Steps = sum(Steps)
  )

【讨论】：