我有一个项目的数据框,其中包含在不同时间发生的一定数量的不同事件。例如说我在各种足球比赛中有过一些事件(目标,角球,红牌等......)。我想计算每场比赛中每支球队在一定时间之前发生的每项赛事的数量(每场比赛的时间不同)。
所以我可以有一个事件数据框(其中C是角,G是目标,R是红牌),如下所示:
events <- data.frame(
game_id = c(1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2),
team = c(1, 1, 2, 1, 2, 2, 1, 1, 2, 2, 2, 1, 1),
event_id= c('C', 'C', 'C', 'G', 'C', 'R', 'C', 'C', 'C', 'C', 'G', 'G', 'C'),
time = c(5, 14, 27, 67, 78, 87, 10, 19, 33, 45, 60, 78, 89))
以及查找每个事件的另一个数据帧,如下所示:
eventTime <- data.frame(
game_id = c(1, 2),
time = c(45, 65))
所以对于第一场比赛,我想在第45分钟之前计算每支球队每场比赛的数量,对于第二场比赛,我想做同样的事情,但是在第60分钟,所以返回类似的内容:
game_id time t1_C t1_G t1_R t2_C t2_G t2_R
1 45 2 0 0 1 0 0
2 65 2 0 0 2 1 0
因为在第一场比赛中,team1在第45分钟之前有2个角球,0个进球和0个红牌,而第2个球队有1个角球,0个进球和0个红牌。
我一直这样做是通过使用apply来遍历和分配我追踪的数据并计算行数,但是我有1000行,这需要花费很多时间。
有没有人知道这样做最快的方式?
编辑:我没有提到任何game_id可能会在eventTime数据帧中以不同的时间出现多次。例如。 game_id可以在45和70时出现两次,我希望得到每个独特事件/时间组合的适当计数。
答案 0 :(得分:2)
一步一步地运行以理解,我认为这应该会给你预期的结果。此外,如果你想要它,还有减少代码的空间 -
library(data.table)
library(reshape)
library(reshape2)
events <- data.table(events)
eventTime <- data.table(eventTime)
eventTime[,TimeLimit := time]
setkeyv(eventTime,c('game_id','time'))
setkeyv(events,c('game_id','time'))
eventsSubset <- eventTime[events, roll = -Inf][!is.na(TimeLimit)]
eventsSubset <- eventsSubset[,list(Freq = .N), by = c('team','event_id','game_id','TimeLimit')]
eventsReshaped <- cast(eventsSubset, game_id + TimeLimit ~ event_id+team, fun.aggregate = sum, value = "Freq")
输出
> eventsReshaped
game_id TimeLimit C_1 C_2 G_2
1 1 45 2 1 0
2 2 65 2 2 1
PS-这假设在整个数据集中,每种类型的事件至少会发生一次。此特定代码的输出仅聚合所找到的事件,这就是结果没有所有事件 - 团队组合的原因。如果要确保不会发生这种情况,可以在原始数据集中添加虚拟条目。
答案 1 :(得分:1)
有助于将活动时间重命名为与“时间”不同的内容:
names(eventTime)[2] <- "stopTime"
将停止时间合并到主数据集中:
events <- merge(events,eventTime)
加载有用的包:
library(reshape2)
library(plyr)
在停止时间之前保留事件的子集:
e2 <- subset(events,time<stopTime)
创建一个游戏* team *事件表并将其“融化”为长格式:
m2 <- melt(with(e2,table(game_id,team,event_id)))
重新排列为您首选的广告形式:
m3 <- dcast(m2,game_id~team+event_id)
将停止时间放回结果中:
merge(eventTime,m3)
答案 2 :(得分:1)
感谢你们两位,我认为你们的答案都能解答我最初的问题,但对于编辑问题却不会有用。但是,我已将你的两个答案的部分内容结合起来,以获得适合我的内容。
我使用Ben Bolkers的第一部分通过合并数据框和子集来确定时间小于stopTime。然后转换为数据表并使用Coderemifa的最后两行答案。所以有些如下
library(reshape)
library(reshape2)
library(plyr)
names(eventTime)[2] <- "stopTime"
events <- merge(events,eventTime)
e2 <- subset(events,time<stopTime)
eventsSubset <- data.table(e2)
eventsSubset <- eventsSubset[,list(Freq = .N), by=c('team','event_id','game_id','stopTime')]
eventsReshaped <- cast(eventsSubset, game_id + stopTime~ event_id+team, fun.aggregate = sum, value = "Freq")