R - 计数事件对的出现次数

问题描述

我有一个数据集,某些用户的某些事件成功与否。具有 2 个用户和 3 个不同事件的示例:

data.frame(
   id      = c('A','A','B','B'),event   = c('score','pass','dribble','score','dribble'),success = c(1,1,1)
)
# id  event success
# A   score       1
# A    pass       1
# A dribble       1
# B   score       0
# B    pass       1
# B dribble       1

我想测量事件之间的关系,用户有多少次出现 2 个成功事件。当 event1 实现时, event2 是否也经常实现?事件 1 和事件 2 是否相关?

在这个有 2 个用户的例子中,都实现了事件 2 和 3,但只有一个实现了事件 1。预期输出是:

data.frame(
   event1  = c('score','pass'),event2  = c('pass',corr    = c(0.5,0.5,1) 
)
# event1   event2   corr
#  score     pass     .5
#  score  dribble     .5
#   pass  dribble      1

这样的表格将帮助我建立一个网络,以加权和突出不同事件之间的联系。 提前致谢。

我可以想象一个带有 for 循环的解决方案,但我想还有更优雅的东西。 :)

解决方法

这是使用一些 dplyr 函数的方法。

library(dplyr)
df <- data.frame(
   id      = c('A','A','B','B'),event   = c('score','pass','dribble','score','dribble'),success = c(1,1,1)
)

expand.grid(event1 = df$event,event2 = df$event) %>%  # generate all possible event combinations
  filter(event1 != event2) %>% # remove event1 = event2
  filter(!duplicated(data.frame(t(apply(.,sort))))) %>% # remove duplicates
  inner_join(df,by =c("event1" = "event")) %>% #adding the successes
  inner_join(df,by = c("event2" = "event"),suffix = c("_1","_2")) %>%
  group_by(across(starts_with("event"))) %>%
  summarise(across(starts_with("success"),sum),.groups = "keep") %>%  # sum successes
  summarise(corr = success_2 / success_1,.groups = "drop") # calculate your corr

# A tibble: 3 x 3
  event1  event2  corr
  <chr>   <chr>  <dbl>
1 dribble pass     1  
2 dribble score    0.5
3 pass    score    0.5

第二个过滤器行改编自另一个堆栈溢出问题: How to remove duplicates based on the combinations of two columns

,

首先,相关性应该是 corr = c (0,1),因为对于 score passscore dribble,事件 1 有一半时间涉及事件 2,另一半时间则不涉及。

其次,我将复制您的数据(稍作改动),因为您无法仅计算两行的相关性(3 对 2 行的事件不起作用):

df <- rbind(df,mutate(df,success=1-success))

假设数据按id和事件发生排序,可以试试这个代码:

library(dplyr)
library(purrr)
   
event_diff <- c(1L,2L)

my_fun <- function(ed,df){
      df %>% mutate(id2=lead(id,n=ed),event2=lead(event,success2=lead(success,n=ed)) %>%
            filter(id==id2 ) %>%
            select(-id,-id2)}

events <- map_dfr(event_diff,my_fun,df=df)

map_dfr(split(events,paste(events$event,events$event2)),function(x)data.frame(event1=x$event[1],event2=x$event2[1],corr=cor(x$success,x$success2)))