R: вычислить число различных категорий в установленные сроки

Question

вот некоторые фиктивные данные:

user_id  date category 
     27 2016-01-01 apple 
     27 2016-01-03 apple 
     27 2016-01-05  pear 
     27 2016-01-07  plum 
     27 2016-01-10 apple 
     27 2016-01-14  pear 
     27 2016-01-16  plum 
     11 2016-01-01 apple 
     11 2016-01-03  pear 
     11 2016-01-05  pear 
     11 2016-01-07  pear 
     11 2016-01-10 apple 
     11 2016-01-14 apple 
     11 2016-01-16 apple 

Я хотел бы вычислить для каждого user_id числа различных categories в определенный период времени (например, в за последние 7, 14 дней), в том числе текущего заказа

решение будет выглядеть следующим образом:

user_id  date category distinct_7 distinct_14 
     27 2016-01-01 apple   1   1 
     27 2016-01-03 apple   1   1 
     27 2016-01-05  pear   2   2 
     27 2016-01-07  plum   3   3 
     27 2016-01-10 apple   3   3 
     27 2016-01-14  pear   3   3 
     27 2016-01-16  plum   3   3 
     11 2016-01-01 apple   1   1 
     11 2016-01-03  pear   2   2 
     11 2016-01-05  pear   2   2 
     11 2016-01-07  pear   2   2 
     11 2016-01-10 apple   2   2 
     11 2016-01-14 apple   2   2 
     11 2016-01-16 apple   1   2 

Я разместил похожие вопросы here или here, однако ни одна из них не ссылалась на подсчет совокупных уникальных значений за указанный период времени. Большое спасибо за вашу помощь!

Answer 1

В tidyverse вы можете использовать map_int для итерации по набору значений и упрощения до целого числа à la sapply или vapply. Подсчитайте различные случаи с помощью n_distinct (например, length(unique(...))) подмножества объектов путем сравнения или помощника between, с минимальным значением, установленным соответствующей суммой, вычитаемой с этого дня, и вы настроены.

library(tidyverse) 

df %>% group_by(user_id) %>% 
    mutate(distinct_7 = map_int(date, ~n_distinct(category[between(date, .x - 7, .x)])), 
      distinct_14 = map_int(date, ~n_distinct(category[between(date, .x - 14, .x)]))) 

## Source: local data frame [14 x 5] 
## Groups: user_id [2] 
## 
## user_id  date category distinct_7 distinct_14 
##  <int>  <date> <fctr>  <int>  <int> 
## 1  27 2016-01-01 apple   1   1 
## 2  27 2016-01-03 apple   1   1 
## 3  27 2016-01-05  pear   2   2 
## 4  27 2016-01-07  plum   3   3 
## 5  27 2016-01-10 apple   3   3 
## 6  27 2016-01-14  pear   3   3 
## 7  27 2016-01-16  plum   3   3 
## 8  11 2016-01-01 apple   1   1 
## 9  11 2016-01-03  pear   2   2 
## 10  11 2016-01-05  pear   2   2 
## 11  11 2016-01-07  pear   2   2 
## 12  11 2016-01-10 apple   2   2 
## 13  11 2016-01-14 apple   2   2 
## 14  11 2016-01-16 apple   1   2 

Answer 2

Вот два data.table решения, одна с двумя вложенными lapply, а другими с помощью нон-соединяющих следа.

Первый - довольно неуклюжие решения data.table, но он воспроизводит ожидаемый ответ. И это будет работать для произвольного количества временных рамок. (Хотя краткое решение tidyverse @ alistaire, которое он предложил в своем комментарии, также может быть изменено).

Он использует два вложенных lapply. Первый цикл проходит по временным рамкам, второй - по датам. Результат tempory объединяется с исходными данными и затем преобразуется из длинного в широкий формат, поэтому мы закончим отдельный столбец для каждого из временных рамок.

library(data.table) 
tmp <- rbindlist(
    lapply(c(7L, 14L), 
     function(ldays) rbindlist(
      lapply(unique(dt$date), 
        function(ldate) { 
        dt[between(date, ldate - ldays, ldate), 
         .(distinct = sprintf("distinct_%02i", ldays), 
         date = ldate, 
         N = uniqueN(category)), 
         by = .(user_id)] 
        }) 
     ) 
) 
) 
dcast(tmp[dt, on=c("user_id", "date")], 
     ... ~ distinct, value.var = "N")[order(-user_id, date, category)] 
#   date user_id category distinct_07 distinct_14 
# 1: 2016-01-01  27 apple   1   1 
# 2: 2016-01-03  27 apple   1   1 
# 3: 2016-01-05  27  pear   2   2 
# 4: 2016-01-07  27  plum   3   3 
# 5: 2016-01-10  27 apple   3   3 
# 6: 2016-01-14  27  pear   3   3 
# 7: 2016-01-16  27  plum   3   3 
# 8: 2016-01-01  11 apple   1   1 
# 9: 2016-01-03  11  pear   2   2 
#10: 2016-01-05  11  pear   2   2 
#11: 2016-01-07  11  pear   2   2 
#12: 2016-01-10  11 apple   2   2 
#13: 2016-01-14  11 apple   2   2 
#14: 2016-01-16  11 apple   1   2 

Вот вариант following a suggestion by @Frank который использует data.table «S без оборудов присоединяется вместо второго lapply:

tmp <- rbindlist(
    lapply(c(7L, 14L), 
     function(ldays) { 
      dt[.(user_id = user_id, dago = date - ldays, d = date), 
       on=.(user_id, date >= dago, date <= d), 
       .(distinct = sprintf("distinct_%02i", ldays), 
       N = uniqueN(category)), 
       by = .EACHI] 
     } 
) 
)[, date := NULL] 
# 
dcast(tmp[dt, on=c("user_id", "date")], 
     ... ~ distinct, value.var = "N")[order(-user_id, date, category)] 

данных:

dt <- fread("user_id  date category 
     27 2016-01-01 apple 
     27 2016-01-03 apple 
     27 2016-01-05  pear 
     27 2016-01-07  plum 
     27 2016-01-10 apple 
     27 2016-01-14  pear 
     27 2016-01-16  plum 
     11 2016-01-01 apple 
     11 2016-01-03  pear 
     11 2016-01-05  pear 
     11 2016-01-07  pear 
     11 2016-01-10 apple 
     11 2016-01-14 apple 
     11 2016-01-16 apple") 
dt[, date := as.IDate(date)] 

BTW: Формулировка в последние 7, 14 дней несколько вводит в заблуждение как время периоды фактически состоят из 8 и 15 дней, соответственно.