Агрегированные данные на основе двух разных методов оценки в R

Question

Я собираюсь собрать некоторые данные шагомера, собранные с шагом в минуту, поэтому я получаю общее количество шагов до оценки 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

I Я хочу добавить данные шагомера к данным 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, поэтому тот же процесс для 4 момента времени оценки EMA 2/5/2020, 2/6/2020 и т. д. c.

Это привело меня к ограничению моих навыков R, поэтому любые указатели были бы чрезвычайно полезны! Я больше всего знаком с Tidyverse, но мне удобно использовать и базу R. Заранее благодарим за все советы.

Answer 1

Вот решение с использованием подвижных соединений из data.table. Основная идея c заключается в том, чтобы каждый раз переходить от pedometer данных до к следующему разу в данных EMA (при сопоставлении по идентификатору еще). Как только будет найдено следующее время 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

^{Создано в 2020-02-04 пакетом Представить (v0.3.0)}

Answer 2

Я бы left_join ema_df на pedometer_df на ID и Time. Таким образом, вы получите все строки pedometer_df с пропущенными значениями для x и y (которые, я предполагаю, являются идентификаторами), когда это не время оценки EMA.

Я заполняю значения, используя следующую доступную (таким образом, следующую оценку ema x и y) и, наконец, group_by ID x и y и summarise, чтобы сохранить дата и время оценки (max) и сумма шагов.

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