текущий счет отдельных пользователей

Я хочу подсчитать скользящее количество уникальных пользователей с переменными временными окнами. Вот пример того, что у меня есть, и желаемого результата.

have <- data.frame(user = c(1, 2, 
                            2, 3, 
                            1, 2, 3, 
                            4, 
                            3, 4,
                            4),
                   when = lubridate::ymd("2020-01-01",
                                         "2020-01-01",
                                         "2020-01-02",
                                         "2020-01-02",
                                         "2020-01-03",
                                         "2020-01-03",
                                         "2020-01-03",
                                         "2020-01-05",
                                         "2020-01-06",
                                         "2020-01-06",
                                         "2020-01-07"))
have 
#   user       when
#1     1 2020-01-01
#2     2 2020-01-01
#3     2 2020-01-02
#4     3 2020-01-02
#5     1 2020-01-03
#6     2 2020-01-03
#7     3 2020-01-03 # note that Jan 4 is missing
#8     4 2020-01-05
#9     3 2020-01-06
#10    4 2020-01-06
#11    4 2020-01-07

want <- data.frame(when=c("2020-01-01",
                          "2020-01-02",
                          "2020-01-03",
                          "2020-01-04",
                          "2020-01-05",
                          "2020-01-06",
                          "2020-01-07"),
                   twoDayCount=c(2, # Jan 1: 1, 2
                                 3, # Jan 1-2: 1, 2, 3
                                 3, # Jan 2-3: 1, 2, 3
                                 3, # Jan 3-4: 1, 2, 3
                                 1, # Jan 4-5: 4
                                 2, # Jan 5-6: 3, 4
                                 2  # Jan 6-7: 3, 4
                                 )
                   )
want
#        when twoDayCount
#1 2020-01-01           2 # users: 1, 2
#2 2020-01-02           3 # users: 1, 2, 3
#3 2020-01-03           3 # users: 1, 2, 3
#4 2020-01-04           3 # users: 1, 2, 3
#5 2020-01-05           1 # users: 4
#6 2020-01-06           2 # users: 3, 4
#7 2020-01-07           2 # users: 3, 4

Я пробовал несколько подходов, но они заставляют меня подсчитывать все строки в окне, а не отдельных пользователей в окне. Например, желаемое двухдневное количество уникальных пользователей 3 января составляет 3 (пользователи 1, 2, 3), а не 5 строк (при этом пользователи 2 и 3 появляются дважды).

В моем фактическом варианте использования в качестве входных данных требуется период скользящего окна (в данном примере 2 дня).

В идеале решение работает с функциями, которые {dbplyr} можно переводить в sql или через собственный sql, который можно запускать с {dbplyr}.

Этот ответ дает представление о том, как решить с помощью sql:

SELECT when, count(DISTINCT user) AS dist_users 
FROM  (SELECT generate_series('2020-01-01'::date, '2020-01-07'::date, '1d')::date) AS g(when) 
LEFT   JOIN tbl t ON t.when BETWEEN g.when - 2 AND g.when 
GROUP  BY 1 
ORDER  BY 1;

person Eric Green    schedule 22.07.2020    source источник


Ответы (4)


Используя функции из dplyr и tidyr для случая однодневного окна:

have %>% 
  group_by(when) %>% 
  summarise(twoDayCount = n_distinct(user))

Для больших окон:

window <- 2
have %>% 
  rowwise() %>% 
  mutate(when = list(when + lubridate::days(0:(window - 1)))) %>% 
  unnest(cols = when) %>%
  group_by(when) %>% 
  summarise(twoDayCount = n_distinct(user))

Обратите внимание, что этот метод предоставит вам строки для нескольких более поздних дат (в данном случае 8 января), которые вы, возможно, захотите удалить.

Если производительность является проблемой для больших наборов данных, вот гораздо более быстрое (но немного менее элегантное) решение:

window <- 2
seq.Date(min(have$when), max(have$when), by = "day") %>% 
  purrr::map(function(date) {
    have %>% 
        filter(when <= date, when >= date - days(window - 1))  %>%
        summarise(userCount = n_distinct(user)) %>%
        mutate(when = date)
    }) %>% 
  bind_rows()
person BluVoxe    schedule 22.07.2020
comment
Спасибо, @BluVoxe. Очень креативный ответ. Мне это нравится. Проблема в том, что я не могу заставить его завершить работу в моем реальном варианте использования с ›1 млн строк и окнами на срок до 30 дней :( - person Eric Green; 22.07.2020
comment
Я вижу, как это может сказаться на производительности! Мне нравится эта проблема, поэтому я найду решение с более высокой производительностью :) - person BluVoxe; 22.07.2020
comment
@EricGreen. Если у вас проблемы с размером и скоростью, вы, вероятно, захотите переключиться на data.table. Измените дату на день с определенной даты. Затем установите дату и пользователя в качестве ключей. Затем вы можете прокручивать каждый день, подмножество предыдущих 30 дней, работать с уникальными пользователями, и благодаря возможности двоичного поиска data.table (который, я думаю, работает как при подмножестве, так и при получении уникальных значений), это может дать вам огромная скорость. Если бы я не был занят, я бы нашел решение - person Robert Wilson; 22.07.2020
comment
@EricGreen Теперь я отредактировал ответ, чтобы дать решение, которое работает намного быстрее с большими наборами данных. Если это решит вашу проблему, вы не против принять решение? - person BluVoxe; 22.07.2020

С петлей наверное немного коряво. Но вроде работает ...

want <- data.frame(when = seq.Date(min(have$when), max(have$when), by = 1), 
                   twoDayCount = NA)

for (iDate in min(want$when):(max(want$when))) {
  dateWindow = c(iDate, iDate - 1)
  uniqueUsers = unique(have$user[have$when %in% dateWindow])
  want$twoDayCount[want$when == iDate] = length(uniqueUsers)
}
        when twoDayCount
1 2020-01-01           2
2 2020-01-02           3
3 2020-01-03           3
4 2020-01-04           3
5 2020-01-05           1
6 2020-01-06           2
7 2020-01-07           2
person AndreasM    schedule 22.07.2020

Вероятно, это не будет перенесено на dbplyr. Но вы можете подойти к этому, используя подход tidyverse.

Сначала вы хотите создать вложенный фрейм данных. 3 столбца. Во-первых, свидание. Второе - это пользователи на эту дату, второе - это пользователи за предыдущий день (если доступно). Затем вы можете использовать purrr::map2, чтобы применить функцию к этим наборам данных, чтобы узнать, сколько у вас уникальных пользователей.

library(dplyr)
library(lubridate)
library(tidyr)
library(purrr)

# A function to get the number of distinct elements in a couple of dfs
num_distinct <- function(x,y){
  length(unique(c(x$user,y$user)))
}


df <- have %>% 
  distinct() %>% 
  group_by(when) %>% 
  nest() %>% 
  ungroup() %>% 
  inner_join(
    have %>% 
      distinct() %>% 
      group_by(when) %>% 
      nest()  %>% 
      ungroup() %>% 
      mutate(when = when + days(1)) %>% 
      rename(lag = data)
  ) 
  # calculate the rolling number of uniques
  df %>% 
  mutate(rolling = map2(data, lag, num_distinct)) %>% 
  select(-data, -lag) %>% 
  unnest(rolling)

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

person Robert Wilson    schedule 22.07.2020

Масштабируемым решением для очень больших наборов данных было бы использование data.table. В приведенном ниже примере я показываю, как это будет работать, если день равен количеству дней с даты начала.

library(tidyverse)
library(data.table)

window <- 30
dt <- tibble(day = seq(1:10000)) %>% 
  mutate(user = purrr::map(day, function(.) sample(1:10000, 10000, replace = TRUE))) %>% 
  unnest(user) %>% 
  as.data.table()

all_res <- list()

setkey(dt, day)

tracker <- 1
for(dd in unique(dt$day)){

  sub_dd <- dt[.(max(1,(dd-window)):dd)]

  all_res[[tracker]] <- tibble(day = dd, users = 
     length(unique(sub_dd[,user])))

  tracker <- tracker + 1

 }

all_res <- all_res %>% 
  bind_rows()

Ключевым моментом здесь является установка ключа, который позволяет data.table использовать двоичный поиск для ускорения фильтрации https://cran.r-project.org/web/packages/data.table/vignettes/datatable-keys-fast-subset.html.

person Robert Wilson    schedule 22.07.2020