R: Скорость / Агрегация - избыточные уникальные подсчеты столбца B на столбец A в течение определенных периодов времени? - PullRequest
Новая
       125

R: Скорость / Агрегация - избыточные уникальные подсчеты столбца B на столбец A в течение определенных периодов времени?

0 голосов
/ 14 июля 2020

Я изучаю способы определить, когда счетчик превышает определенный порог в течение определенного периода времени.

Например, предположим, что у нас есть 4 столбца - Транзакция, Время, Электронная почта и CC. Во всем наборе данных мы хотим определить, КАКИЕ электронные письма пользователей (электронная почта) связаны с более чем двумя кредитными картами (CC) в течение ЛЮБОГО 60-минутного периода. В идеале мы также хотели бы знать, в ЧТО (транзакция) этот порог нарушен.

Конечная цель - узнать что-то вроде этого -

'CB C' использовал третий ( CC) за <= 60 минут в 50 «Транзакция». </p>

Смоделированные данные: 

library(stringi)
set.seed(123)
CC <- sample(1000:1199, 100, replace = TRUE)
Email <- stri_rand_strings(100, 3, pattern = "[A-D]")
Time <- as.POSIXct("2020-01-01 00:00") + sort(sample(1:10000, 100))
DF <- data.frame(Time, Email, CC) 
DF <- tibble::rowid_to_column(DF, "Transaction")
              
> head(DF)
  Transaction                Time Email   CC
1           1 2020-01-01 00:00:05   CBB 1057
2           2 2020-01-01 00:04:40   DBD 1157
3           3 2020-01-01 00:08:11   DCB 1081
4           4 2020-01-01 00:09:39   ADB 1176
5           5 2020-01-01 00:11:39   ADC 1188
6           6 2020-01-01 00:13:45   ACD 1009

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

Ранняя попытка dplyr настроить это выглядит следующим образом - 

Counts_DF <- DF %>%
  group_by(Email)  %>%
  mutate(HourInter = cut(Time, breaks = "60 min"))   %>%
  group_by(Email, HourInter)  %>%
  summarize(Diff_Cards = n_distinct(CC)) %>% 
  arrange(desc(Diff_Cards)) %>%
  filter(Diff_Cards > 2)

> head(Counts_DF)
# A tibble: 5 x 3
# Groups:   Email [5]
  Email HourInter           Diff_Cards
  <fct> <chr>                    <int>
1 ABB   2020-01-01 01:22:00          3
2 BAC   2020-01-01 00:54:00          3
3 CAB   2020-01-01 00:35:00          3
4 CBC   2020-01-01 00:14:00          3
5 DAB   2020-01-01 01:41:00          3

Однако я не уверен, что такое столбец 'HourInter' действительно работает, и явно нет доступной информации о (транзакции).

Я встречал другие вопросы для агрегирования с временными интервалами stati c только для одного столбца, но это явно немного другое. Любая помощь в этом будет принята с благодарностью.

Ответы [ 2 ]

1 голос
/ 14 июля 2020

вот data.table -подход 

library( data.table )
#make DF a data.table, set keys for optmised joining
setDT( DF, key = c("Email", "Time" ) )
#get CC used in hour window, and number of unique CC used last hour, by Email by row
DF[ DF, 
    #get desired values, suppress immediate output using {}
    c( "cc_last_hour", "unique_cc_last_hour" ) := {
      #temporary subset, with all DF values with the same Email, from the last hour
      val = DF[ Email == i.Email & 
                  Time %between% c( i.Time - lubridate::hours(1), i.Time) ]$CC
      #get values
      list( paste0( val, collapse = "-" ),
            uniqueN( val ) )
    }, 
    #do the above for each row
    by = .EACHI ]

#now subset rows where `unique_cc_used_last_hour` exceeds 2
DF[ unique_cc_last_hour > 2, ]

#    Transaction                Time Email   CC        cc_last_hour unique_cc_last_hour
# 1:          66 2020-01-01 01:35:32   AAD 1199      1152-1020-1199                   3
# 2:          78 2020-01-01 02:00:16   AAD 1152 1152-1020-1199-1152                   3
# 3:          53 2020-01-01 01:24:46   BAA 1096      1080-1140-1096                   3
# 4:          87 2020-01-01 02:15:24   BAA 1029      1140-1096-1029                   3
# 5:          90 2020-01-01 02:19:30   BAA 1120      1096-1029-1120                   3
# 6:          33 2020-01-01 00:55:52   BBC 1031      1196-1169-1031                   3
# 7:          64 2020-01-01 01:34:58   BDD 1093      1154-1052-1093                   3
# 8:          68 2020-01-01 01:40:07   CBC 1085      1022-1052-1085                   3
# 9:          38 2020-01-01 01:03:34   CCA 1073      1090-1142-1073                   3
#10:          21 2020-01-01 00:35:54   DBB 1025      1194-1042-1025                   3
#11:          91 2020-01-01 02:20:33   DDA 1109      1115-1024-1109                   3

обновление на основе комментария OP ниже

сначала создайте несколько образцов данных с суммой транзакции 

#sample data with an added Amount
library(stringi)
set.seed(123)
CC <- sample(1000:1199, 100, replace = TRUE)
Email <- stri_rand_strings(100, 3, pattern = "[A-D]")
Time <- as.POSIXct("2020-01-01 00:00") + sort(sample(1:10000, 100))
Amount <- sample( 50:100, 100, replace = TRUE )
DF <- data.frame(Time, Email, CC, Amount) 
DF <- tibble::rowid_to_column(DF, "Transaction")

вот код для вычисления суммы Amount за последний час. Еще немного объяснения функциональности кода

  1. сделать DF таблицей данных
  2. 'l oop' над каждой строкой DF
  3. для каждого В строке возьмите адрес электронной почты и время в этой строке и ...
  4. ... создайте временное подмножество DF, где адрес электронной почты тот же, а время равно времени - 1 час и время
  5. присоединяется к этому подмножеству, создавая новые столбцы «cc_hr», «un_cc_hr» и «am_hr», значения которых получают из списка. Таким образом, paste0( val$CC, collapse = "-" ) заполняет первый столбец (например, «cc_hr»), uniqueN( val$CC ) заполняет второй столбец (например, «un_cc_hr»), и сумма суммы («am_hr») вычисляется как sum( val$Amount ).

Как видите, он не вычисляет оценку для каждого 60-минутного интервала, а вместо этого определяет конец интервала на основе времени транзакции, а затем ищет транзакции с тем же адресом электронной почты в за час до времени. Я предположил, что это именно то поведение, которое вы ищете, и вас не интересуют периоды, когда ничего не происходит. 

library( data.table )
#make DF a data.table, set keys for optmised joining
setDT( DF, key = c("Email", "Time" ) )
#self join
DF[ DF, 
    #get desired values, suppress immediate output using {}
    c( "cc_hr", "un_cc_hr", "am_hr" ) := {
      #create a temporary subset of DF, named val, 
      #   with all DF's rows with the same Email, from the last hour
      val = DF[ Email == i.Email & 
                  Time %between% c( i.Time - lubridate::hours(1), i.Time) ]
      #get values
      list( paste0( val$CC, collapse = "-" ),
            uniqueN( val$CC ),
            sum( val$Amount ) )  # <-- calculate the amount of all transactions 
    }, 
    #do the above for each row of DF
    by = .EACHI ]

пример вывода 

#find all Transactions where, in the past hour,
#   1. the number of unique CC used > 2, OR 
#   2. the total amount paid > 180

DF[ un_cc_hr > 2 | am_hr > 180, ]
#     Transaction                Time Email   CC Amount               cc_hr un_cc_hr am_hr
#  1:          80 2020-01-01 02:03:05   AAB 1021     94           1089-1021        2   194
#  2:          66 2020-01-01 01:35:32   AAD 1199     60      1152-1020-1199        3   209
#  3:          78 2020-01-01 02:00:16   AAD 1152     63 1152-1020-1199-1152        3   272
#  4:          27 2020-01-01 00:40:50   BAA 1080    100           1169-1080        2   186
#  5:          53 2020-01-01 01:24:46   BAA 1096    100      1080-1140-1096        3   259
#  6:          87 2020-01-01 02:15:24   BAA 1029     71      1140-1096-1029        3   230
#  7:          90 2020-01-01 02:19:30   BAA 1120     93      1096-1029-1120        3   264
#  8:          33 2020-01-01 00:55:52   BBC 1031     55      1196-1169-1031        3   171
#  9:          64 2020-01-01 01:34:58   BDD 1093     78      1154-1052-1093        3   212
# 10:          42 2020-01-01 01:08:04   CBC 1052     96           1022-1052        2   194
# 11:          68 2020-01-01 01:40:07   CBC 1085    100      1022-1052-1085        3   294
# 12:          38 2020-01-01 01:03:34   CCA 1073     81      1090-1142-1073        3   226
# 13:          98 2020-01-01 02:40:40   CCC 1121     86           1158-1121        2   183
# 14:          21 2020-01-01 00:35:54   DBB 1025     67      1194-1042-1025        3   212
# 15:          91 2020-01-01 02:20:33   DDA 1109     99      1115-1024-1109        3   236
0 голосов
/ 14 июля 2020

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

library(stringi)
library(tidyverse)
library(lubridate)
set.seed(123)
CC <- sample(1000:1199, 100, replace = TRUE)
Email <- stri_rand_strings(100, 3, pattern = "[A-D]")
Time <- as.POSIXct("2020-01-01 00:00") + sort(sample(1:10000, 100))
DF <- data.frame(Time, Email, CC) 
DF <- tibble::rowid_to_column(DF, "Transaction")

DF %>% 
  mutate(Date = as.Date(Time),
         Hour = hour(Time)) %>% 
  group_by(Date, Hour, Email) %>% 
  summarise(Diff_Cards = n_distinct(CC)) %>% 
  filter(Diff_Cards > 2) %>% 
  arrange(desc(Diff_Cards))
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.

Похожие темы

...