R：速度/聚合 - 在特定时间段内每列 A 的列 B 的唯一计数过多？
Posted
技术标签:
【中文标题】R：速度/聚合 - 在特定时间段内每列 A 的列 B 的唯一计数过多？【英文标题】：R: Velocity/Aggregation - excess unique counts of column B per column A within certain time periods? 【发布时间】：2020-11-03 11:06:58 【问题描述】：我正在探索如何确定某个时间段内计数何时超过某个阈值。
例如，假设我们有 4 列 - 交易、时间、电子邮件和抄送。在整个数据集中，我们希望在任何 60 分钟内识别出哪些用户电子邮件 (Email) 涉及超过 2 张信用卡 (CC)。理想情况下，我们还想知道这个阈值在什么（交易）被打破。
最终目标是知道这样的事情-
'CBC' 在 'Transaction' 50 处
模拟数据：
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”列到底在做什么，而且显然没有可用的（交易）信息。
我已经看到其他关于静态时间间隔下仅针对一列的聚合的问题，但这显然有点不同。对此的任何帮助将不胜感激。
【问题讨论】：
【参考方案1】：这是一个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")
这里也是计算过去一小时的金额总和的代码。 对代码功能的更多解释
-
使 DF 成为 data.table
在 DF 的每一行上“循环”
对于每一行，获取该行的电子邮件和时间，然后...
... 创建 DF 的临时子集，其中 Email 相同，时间在 Time - 1 小时和 Time 之间
加入这个子集，创建新列“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
【讨论】：
作为后续，如果我们去掉 (CC) 列并用 (Amount) 列替换它会怎样。然后，假设我想确定某个美元阈值（金额）在特定时间段内被同一（电子邮件）打破的时间。所以，非常相似的想法，除了现在我们将在一列中求和而不是计算唯一值。例如 - 假设我们要识别在任何 60 分钟内涉及超过 150 美元（金额）的用户电子邮件（电子邮件）。我正在使用您的代码进行设置，但有点卡住了。谢谢！ 这也是可能的，只是对代码进行了一些修改......请参阅上面的更新答案。我还包括了更多关于代码的 cmets 和解释。当您记住您正在“循环”DF 的行时，处理临时子集（基于当前行中的值）并正在对该子集执行计算, 代码可能/有希望实现 ;-) 很好的解释，它看起来和工作都很棒！我会知道这是否在大约一周内通过生产数据验证！【参考方案2】：您总是可以通过提取日期和时间特征来简化问题：
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))
【讨论】：
感谢您对提取日期和时间的反馈！以上是关于R：速度/聚合 - 在特定时间段内每列 A 的列 B 的唯一计数过多？的主要内容，如果未能解决你的问题，请参考以下文章