Групповые подведения итогов за пределами группового dplyr

Question

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

library(dplyr)
library(lubridate)

set.seed(100)
df <- data.frame(ids = sample(c('436247', '2465347', '346654645'), 10000, replace=TRUE),
                 date = sample(seq.Date(ymd('2018-03-01'), ymd('2018-05-01'), by=1), 10000, replace=TRUE))

new_df <- df %>%
    group_by(ids, date) %>%
    summarise(events = length(ids[date >= date - 30 & date <= date]))

Я пытаюсь взять этот фрейм данных и ответить на вопрос - «для каждого из идентификаторов и каждой даты, сколько других записей в этом идентификаторе находятся в течение последних 30 дней этой даты». К сожалению, когда я group_by и идентификаторы и дата, это только смотрит в сгруппированную дату. Я создал решение ниже, но не уверен, что есть лучшее решение с dplyr?

groupby_function <- function(df, spec_date){
  result <- df %>%
      group_by(ids) %>%
      summarise(events = length(ids[date >= spec_date - 30 & date <= spec_date])) %>%
      mutate(date = spec_date)
  return(result)

} 

date_vector <- seq.Date(ymd('2018-03-01'), ymd('2018-05-01'), by=1)
list_results <- lapply(date_vector, groupby_function, df=df)
x <- do.call(rbind, list_results)

Answer 1

Вот ответ. Но предполагается, что в каждом id.

есть непрерывная последовательность дат.

df %>%
  group_by(ids, date) %>%
  count() %>%
  arrange(ids, date) %>%
  group_by(ids) %>%
  mutate(
    events = cumsum(n) - cumsum(lag(n, 30, 0))
  )

Answer 2

"для каждого из идентификаторов и каждой даты, сколько других записей в этом идентификаторе находятся в течение последних 30 дней с этой даты"

Для этого имеет смысл условие "присоединиться", но еще не включено в dplyr . Пока это не так, вы можете использовать data.table внутри вашей цепочки dplyr:

# enumerate id-date combos of interest
grid_df = expand.grid(
  id = unique(df$ids), 
  d = seq(min(df$date), max(df$date), by="day")
)

# helper function
library(data.table)
count_matches = function(DF, targetDF, ...){
  onexpr = substitute(list(...))
  data.table(targetDF)[DF, on=eval(onexpr), .N, by=.EACHI]$N
}

# use a non-equi join to count matching rows
res = grid_df %>% 
  mutate(d_dn = d - 30) %>% 
  mutate(n = count_matches(., df, ids = id, date >= d_dn, date <= d)) %>% 
  as.tibble

# A tibble: 186 x 4
          id          d       d_dn     n
      <fctr>     <date>     <date> <int>
 1    436247 2018-03-01 2018-01-30    72
 2   2465347 2018-03-01 2018-01-30    69
 3 346654645 2018-03-01 2018-01-30    51
 4    436247 2018-03-02 2018-01-31   123
 5   2465347 2018-03-02 2018-01-31   120
 6 346654645 2018-03-02 2018-01-31   100
 7    436247 2018-03-03 2018-02-01   170
 8   2465347 2018-03-03 2018-02-01   166
 9 346654645 2018-03-03 2018-02-01   154
10    436247 2018-03-04 2018-02-02   228
# ... with 176 more rows

Я думаю, что в условиях равенства должно работать нормально ids = id или ids == id.

Если вам интересно, синтаксис будет x[i, on=, j, by=.EACHI], где x и i - таблицы. Для каждой строки i мы ищем строки x на основе критериев on= (левая часть относится к столбцам в x; правая часть к столбцам в i); тогда мы делаем j для каждого («по каждой строке i», поэтому by=.EACHI). В этом случае j = .N означает, что мы считаем совпадающие строки x, возвращаемые в виде столбца подсчетов N.

Answer 3

Если приемлемо решение «не dplyr», это дает вам то, что вы хотите.

df$diff <- as.vector(
  sapply(unique(df$ids), function(x)
    sapply(df$date[df$ids == x], function(y)
      sum(abs(y - df$date[df$ids == x]) >= 30)
      )
    )
  )

Кроме того, в dplyr вы можете получить результат, подобный приведенному выше, используя:

f <- function(x) {
  sapply(x, function(y) sum(abs(y - x) >= 30))
  }

df$diff <- unlist(
  df %>%
    group_by(ids) %>%
    do(diff = f(.$date)) %>%
    .$diff
  )

Answer 4

Вы можете посмотреть на «разгруппированные» данные, просто вернувшись к исходному фрейму данных (вызов df$date или df$ids). Итак, я думаю , что вы ищете, это

test_df <- df %>%
  group_by(ids, date) %>%
  summarise(events = length(df$ids[df$date >= date[1] - 30 & df$date <= date[1] & df$ids == ids[1]]))

Кроме того, я запустил вашу предложенную функцию, но я не увидел никакой разницы в результате от вашего исходного решения group_by, поэтому я не думаю, что это то, что вы хотите.