R: Функция цикла кодирования неисправностей для извлечения признаков?

Question

У меня есть два вектора:

 EventDate <- c("2018-10-31", "2018-11-16", "2018-12-02")
 ThirtyDaysPriorEvent <- c("2018-10-01", "2018-10-17", "2018-11-02")

Мне нужна помощь в написании функции цикла для следующего рабочего процесса:

1. Цикл по векторам для определения дат в тех же позициях индексаи хранить их в переменных.Например, первая пара дат будет EventDate [1] и ThirtyDaysPriorEvent [1].Для данных примера значениями являются «2018-10-31» и «2018-10-01».
2. Используйте переменные в качестве аргументов даты в функции фильтра dplyr.Запросите БД для всех действий, которые произошли за 30 дней до каждой даты события.Сохраните результаты в фрейме данных с именем Actions30dys.
3. Вычислите суммы столбцов в фрейме данных Actions30dys.
4. Создайте новый столбец в фрейме данных Events, используя вычисленные значения из шага № 3.

Вот результат, которого я хочу достичь:

Новый столбец с именем «d» в кадре данных «События», полученный из агрегирующих значений в столбце «x» в кадре данных «Деятельности».

      date  a    b     c     d
2018-10-31 42 60.5 152.4 16.63
2018-11-16 54 54.1 151.6 16.63
2018-12-02 63 74.2 153.5 19.95

Тем не менее, это насколько я получил:

 library(dplyr)

 # identifies dates in the same index position for each vector & stores results in variables
 e <- EventDate[1]
 e30 <- ThirtyDaysPriorEvent[1]

 # uses variables to filter Activities dataframe
 Activities30Dys <- Activities %>%
   filter(date > e30 & date < e) 

 # computes sum of x activity done 30 days prior to event date
 sum(Activities30Dys$x, na.rm = TRUE)

 # adds new column (d) to Events dataframe
 Events %>%
   mutate()

Вот мои воспроизводимые данные:

     Events <- structure(list(date = c("2018-10-31", "2018-11-16", "2018-12-02"
), a = c(42L, 54L, 63L), b = c(60.5, 54.1, 74.2), c = c(152.4, 
151.6, 153.5)), .Names = c("date", "a", "b", "c"), row.names = 
c(NA, 3L), class = "data.frame")

     Activities <- structure(list(date = c("2018-09-18", "2018-09-19", "2018-10-21", 
"2018-10-21", "2018-10-24", "2018-10-26", "2018-10-27", "2018-11-18", 
"2018-11-19", "2018-11-21", "2018-11-24", "2018-11-26", "2018-11-27", 
"2018-12-05"), x = c(3.43, 3.16, 3.2, 3.27, 3.74, 3.2, 3.22, 
3.43, 3.16, 3.2, 3.74, 3.2, 3.22, 3.02), y = c(132L, 122L, 120L, 
130L, 127L, 128L, 127L, 132L, 122L, 120L, 127L, 128L, 127L, 121L
)), .Names = c("date", "x", "y"), row.names = c(NA, 14L), class = "data.frame")

Как мне лучше всего достичь своей цели с помощью R?

Answer 1

Вот один из способов сделать это.Среди многих.

extend_df <- function(events, priors, data) {

require(dplyr)

monthly <- list()
for (i in seq_along(events)) {

  to <- events[i]
  from <- priors[i]

  monthly[[i]] <- data %>%
    filter(date > from & date < to) %>% 
    summarise(n = sum(x)) %>% 
    pull(n)


  }
return(monthly)
}

Events %>% mutate(d = extend_df(EventDate, ThirtyDaysPriorEvent, Activities))

        date  a    b     c     d
1 2018-10-31 42 60.5 152.4 16.63
2 2018-11-16 54 54.1 151.6 16.63
3 2018-12-02 63 74.2 153.5 19.95

Answer 2

Есть несколько способов подойти к нему, которые зависят от того, как он вписывается в ваш рабочий процесс.Семейство функций purrr::map облегчает отображение этих векторов, а не циклическое.В этом случае map2 будет отображаться одновременно по паре векторов.

Первое, что я хотел бы отметить, это то, что, поскольку вы работаете с датами, вы бы хорошо относились к ним как к таким и конвертировалив класс Date.

Другое дело, что неясно, хотите ли вы, чтобы ваши конечные точки при фильтрации были включительно или эксклюзивно .Я использую dplyr::between для краткости, но это будет включать конечные точки.Я позволю вам настроить по мере необходимости.

Один из способов - сопоставить два вектора дат с помощью map2_dfr, чтобы получить фрейм данных, отфильтровать Activities, сгруппировать по дате начала и подвести итоги.Это дает вам фрейм данных, к которому вы затем можете присоединиться с помощью Events, при условии, что вы конвертировали его даты в реальные Date с.

library(dplyr)
library(purrr)

sums_df <- map2_dfr(as.Date(EventDate), as.Date(ThirtyDaysPriorEvent), function(e, e30) {
  activities30dys <- Activities %>%
    mutate(date = as.Date(date)) %>%
    filter(between(date, e30, e)) %>%
    group_by(date = e) %>%
    summarise(d = sum(x, na.rm = T))

  activities30dys
})

Events %>%
  mutate(date = as.Date(date)) %>%
  left_join(sums_df, by = "date")
#>         date  a    b     c     d
#> 1 2018-10-31 42 60.5 152.4 16.63
#> 2 2018-11-16 54 54.1 151.6 16.63
#> 3 2018-12-02 63 74.2 153.5 19.95

Другой вариант - сделать аналогичный map2, но с map2_dbl для возврата одного числового вектора.Затем вы можете mutate добавить это в виде столбца к Events.

sums_dbl <- map2_dbl(as.Date(EventDate), as.Date(ThirtyDaysPriorEvent), function(e, e30) {
  activities30dys <- Activities %>%
    mutate(date = as.Date(date)) %>%
    filter(between(date, e30, e))

  sum(activities30dys$x, na.rm = T)
})

Events %>%
  mutate(d = sums_dbl)
#>         date  a    b     c     d
#> 1 2018-10-31 42 60.5 152.4 16.63
#> 2 2018-11-16 54 54.1 151.6 16.63
#> 3 2018-12-02 63 74.2 153.5 19.95

Последнее замечание: вместо сохранения векторов как дат вашего события, так и даты 30 дней назад, вы можете просторассчитать эту предыдущую дату, как вы идете.Если вы преобразовали в Date, тогда e - 30 даст вам дату за 30 дней до этого, и вы можете вместо этого построить свой рабочий процесс следующим образом:

map(as.Date(EventDate), function(e) {
  e30 <- e - 30
  # ...
})

Answer 3

Я уверен, что мы могли бы сделать полное решение dplyr для этого, но не без существенного изменения данных.

Итак, я предоставил простое решение для цикла, в основном повторное использование написанного вами кода.Небольшие модификации предназначены для разборчивости кода:

#-- Initialize d
Events$d <- NA

#-- Run loop
for (i in 1:nrow(Events)) {
  e <- Events$date[i]
  e30 <- e - 30
  Events$d[i] <- Activities %>%
    filter(between(date, e30, e)) %>%
    summarize(x = sum(x, na.rm = TRUE)) %>%
    pull()
}