我真的需要加速一些R代码。我有一个特定运动的大型数据集。数据框中的每一行代表游戏中的某种类型的动作。对于每场比赛（game_id），我们有两支球队（team_id）参加比赛。数据框中的time_ref是每个游戏按时间顺序排列的动作。 type_id是游戏中的动作类型。 player_off被设置为TRUE或FALSE并且与action_id=3相关联。 action_id=3代表一名球员获得一张牌，player_off被设置为TRUE / FALSE，如果玩家在获得该牌时被罚下场。示例data.frame：
> df
game_id team_id action_id player_off time_ref
100 10 1 NA 1000
100 10 1 NA 1001
100 10 1 NA 1002
100 11 1 NA 1003
100 11 2 NA 1004
100 11 1 NA 1005
100 10 3 1 1006
100 11 1 NA 1007
100 10 1 NA 1008
100 10 1 NA 1009
101 12 3 0 1000
101 12 1 NA 1001
101 12 1 NA 1002
101 13 2 NA 1003
101 13 3 1 1004
101 12 1 NA 1005
101 13 1 NA 1006
101 13 1 NA 1007
101 12 1 NA 1008
101 12 1 NA 1009
我需要的是数据框中的另一个专栏，它给出了TRUE或FALSE，了解两支球队在每次动作（排）发生时球场上是否有相同/不等数量的球员。
所以game_id=100在action_id=3为player_off=1制作了team_id=10和time_ref=1006。所以我们知道球队在场上的数量与球员数量一样，但在剩下的比赛中却不相同（time_ref>1006）。同样的事情也发生在game_id=101。
这是一个数据框的示例，其中包含我希望为数据集添加的额外列。
>df
game_id team_id action_id player_off time_ref is_even
100 10 1 NA 1000 1
100 10 1 NA 1001 1
100 10 1 NA 1002 1
100 11 1 NA 1003 1
100 11 2 NA 1004 1
100 11 1 NA 1005 1
100 10 3 1 1006 1
100 11 1 NA 1007 0
100 10 1 NA 1008 0
100 10 1 NA 1009 0
101 12 3 0 1000 1
101 12 1 NA 1001 1
101 12 1 NA 1002 1
101 13 2 NA 1003 1
101 13 3 1 1004 1
101 12 1 NA 1005 0
101 13 1 NA 1006 0
101 13 1 NA 1007 0
101 12 1 NA 1008 0
101 12 1 NA 1009 0
所以你可以看到，在game_id=100，一名球员被送到了time_ref=1006所以以前的所有行被标记为is_even=1，随后被标记为凹凸不平或0。类似于game_id=101的time_ref=1004。
实现这个额外列的最有效方法是什么？优选不使用for循环。
对于一些矢量
x = c(0, NA, NA, NA, 1, NA, NA, NA)
编写一个函数来标准化数据（0或1个玩家丢失），计算丢失的玩家的累积数量，并将其与零进行比较，
fun0 = function(x) {
x[is.na(x)] = 0
cumsum(x) == 0
}
对于多个组，请将ave()与分组变量一起使用
x = c(x, rev(x))
grp = rep(1:2, each = length(x) / 2)
ave(x, grp, FUN = fun0)
对于问题中的数据，请尝试
df$is_even = ave(df$player_off, df$game_id, FUN = fun)
在语义上，似乎fun0()比这个解决方案中隐含的更复杂，特别是如果每个球队失去一个球员，他们甚至会再次，就像@SunLisa所说的那样。如果是，请清理数据
df$player_off[is.na(df$player_off)] = 0
并改变fun0()，例如，
fun1 <- function(x, team) {
is_team_1 <- team == head(team, 1) # is 'team' the first team?
x1 <- x & is_team_1 # lost player & team 1
x2 <- x & !is_team_1 # lost player & team 2
cumsum(x1) == cumsum(x2) # same total number of players?
}
（将逻辑返回值强制转换为整数似乎不是一个好主意）。这可以通过组来应用
df$is_even = ave(seq_len(nrow(df)), df$game_id, FUN = function(i) {
fun1(df$player_off[i], df$team_id[i])
})
要么
split(df$is_even, df$game_id) <-
Map(fun1,
split(df$player_off, df$game_id),
split(df$team_id, df$game_id)
)
ave()的实现很有用，重要的是
split(x, g) <- lapply(split(x, g), FUN)
右侧通过组x分裂g，然后将FUN()应用于每个组。左侧split<-()是一个棘手的操作，使用组索引来更新原始矢量x。
最初的问题是'no for loops'，但实际上lapply()（在ave()中）和Map()就是这样; ave()是相对有效的，因为它采用了分裂 - 应用 - 组合策略，而不是OP可能实现的，可能通过游戏迭代，数据框的子集，然后更新每个游戏的data.frame。子集将具有整个数据集的重复子集，并且特别是更新将至少复制每个赋值的整个结果列;这种复制会大大减慢执行速度。 OP也有可能与fun0()挣扎;这将有助于澄清问题，特别是标题，以确定这是问题。
有更快的方法，特别是使用data.table包，但原理是相同的 - 确定一个按照你想要的方式对向量进行操作的函数，并按组应用它。
另一种完全矢量化的解决方案遵循this suggestion来计算累积总和。对于fun0()，将x标准化为在特定时间点离开游戏的玩家数量，没有NAs
x[is.na(x)] = 0
相当于fun()，计算离开游戏的玩家的累积总和，不论是哪一组
cs = cumsum(x)
对累积和适用的组更正此问题
in_game = cs - (grp - 1)
当0名玩家离开游戏时，将其设置为“TRUE”
is_even = (in_game == 0)
这取决于grp索引从1到组的数量;这里的数据可能是grp = match(df$game_id, unique(df$game_id))。 fun1()存在类似的解决方案。
这是问题的dplyr + tidyr解决方案，总结了所做的事情：
player_off中的所有NA转换为0来处理数据，以便更容易求和并将较小的team_num（假设只有2个）分配给team1而另一个分配给team2player_off“计算”spreads并使用0填充数据中的无效组合 - 例如，在game_id = 100中，team_id = 1000时没有time_ref = 11lagged team1和team2向量的累积和（当然用N填充NAs）代码如下：
require(dplyr)
require(tidyr)
df %>%
group_by(game_id) %>%
mutate(
player_off = player_off %>% replace(list = is.na(.), values = 0),
team_num = if_else(team_id == min(team_id), "team1", "team2")
) %>%
spread(key = team_num, value = player_off, fill = 0) %>%
arrange(game_id, time_ref) %>%
mutate(
team1_cum = cumsum(lag(team1, default = 0)),
team2_cum = cumsum(lag(team2, default = 0)),
is_even = as.integer(team1_cum == team2_cum)
) %>%
ungroup() %>%
select(-team1, -team2, -team1_cum, -team2_cum)
输出：
# A tibble: 20 x 5
game_id team_id action_id time_ref is_even
<int> <int> <int> <int> <int>
1 100 10 1 1000 1
2 100 10 1 1001 1
3 100 10 1 1002 1
4 100 11 1 1003 1
5 100 11 2 1004 1
6 100 11 1 1005 1
7 100 10 3 1006 1
8 100 11 1 1007 0
9 100 10 1 1008 0
10 100 10 1 1009 0
11 101 12 3 1000 1
12 101 12 1 1001 1
13 101 12 1 1002 1
14 101 13 2 1003 1
15 101 13 3 1004 1
16 101 12 1 1005 0
17 101 13 1 1006 0
18 101 13 1 1007 0
19 101 12 1 1008 0
20 101 12 1 1009 0
这是我的想法：
data.table可以很好地工作，尤其是在处理大型数据集时。它更快。我们只需要对它进行分组，cumsum 2队的裁员，看看他们是否相同。
首先我要说：
（马丁摩根解决了问题，他的更新答案不再出现此错误）
我不认为@Martin Morgan的回答是正确的。让我们想象一下某个案例：
当第一队有一名球员关闭，之后球队2关闭另一名球员，那么两队应该是平局，但@Martin Morgan的输出将是FALSE。
我将用这个数据集做一个例子，其中player_off的record 19被修改为1，这意味着在101在team 13有1 player off之后1004，team 12在1 player off有1008，这将使得两队甚至在1009。
> dt.1
game_id team_id action_id player_off time_ref
1 100 10 1 NA 1000
2 100 10 1 NA 1001
3 100 10 1 NA 1002
4 100 11 1 NA 1003
5 100 11 2 NA 1004
6 100 11 1 NA 1005
7 100 10 3 1 1006
8 100 11 1 NA 1007
9 100 10 1 NA 1008
10 100 10 1 NA 1009
11 101 12 3 0 1000
12 101 12 1 NA 1001
13 101 12 1 NA 1002
14 101 13 2 NA 1003
15 101 13 3 1 1004
16 101 12 1 NA 1005
17 101 13 1 NA 1006
18 101 13 1 NA 1007
19 101 12 1 1 1008
20 101 12 1 NA 1009
但@Martin摩根的功能会产生这样的输出：
> dt.1$is_even = ave(df$player_off, df$game_id, FUN = fun)
> dt.1
game_id team_id action_id player_off time_ref is_even
1 100 10 1 NA 1000 1
2 100 10 1 NA 1001 1
3 100 10 1 NA 1002 1
4 100 11 1 NA 1003 1
5 100 11 2 NA 1004 1
6 100 11 1 NA 1005 1
7 100 10 3 1 1006 1
8 100 11 1 NA 1007 0
9 100 10 1 NA 1008 0
10 100 10 1 NA 1009 0
11 101 12 3 0 1000 1
12 101 12 1 NA 1001 1
13 101 12 1 NA 1002 1
14 101 13 2 NA 1003 1
15 101 13 3 1 1004 1
16 101 12 1 NA 1005 0
17 101 13 1 NA 1006 0
18 101 13 1 NA 1007 0
19 101 12 1 1 1008 0
20 101 12 1 NA 1009 0
请注意如何在line 19和line 20，is.even=0。这不是op想要的。
我的代码不处理NAs，所以我将首先将NA转换为0。
> dt.1<-as.data.table(dt.1)
> dt.1[is.na(dt.1)]<-0
我的代码将产生正确的输出，在时间1008和1009，其中team 12和team 13都有1关，两队甚至。
> dt.1[,.(action_id,team2_off=(team_id==max(team_id))*player_off,team1_off=(team_id==min(team_id))*player_off,team_id,time_ref,player_off),by=game_id][order(game_id,time_ref)][,.(team_id,time_ref,action_id,player_off,even=as.numeric(cumsum(team2_off)==cumsum(team1_off))),by=game_id]
game_id team_id time_ref action_id player_off even
1: 100 10 1000 1 0 1
2: 100 10 1001 1 0 1
3: 100 10 1002 1 0 1
4: 100 11 1003 1 0 1
5: 100 11 1004 2 0 1
6: 100 11 1005 1 0 1
7: 100 10 1006 3 1 0
8: 100 11 1007 1 0 0
9: 100 10 1008 1 0 0
10: 100 10 1009 1 0 0
11: 101 12 1000 3 0 1
12: 101 12 1001 1 0 1
13: 101 12 1002 1 0 1
14: 101 13 1003 2 0 1
15: 101 13 1004 3 1 0
16: 101 12 1005 1 0 0
17: 101 13 1006 1 0 0
18: 101 13 1007 1 0 0
19: 101 12 1008 1 1 1
20: 101 12 1009 1 0 1
我理解这是一个看起来很乱的data.table代码，让我一步一步解释。
dt[, .(
action_id,
team2_off = (team_id == max(team_id)) * player_off,
team1_off = (team_id == min(team_id)) * player_off,
team_id,
time_ref,
player_off
), by = game_id][order(game_id, time_ref)][, .(team_id,
time_ref,
action_id,
player_off,
even = cumsum(team2_off) == cumsum(team1_off)), by = game_id]
首先，我们采用dt的data.table game_id，并计算：
team2_off = (team_id == max(team_id)) * player_off,
team1_off = (team_id == min(team_id)) * player_off
data.table在同时进行2次分组时遇到了一些问题（由game_id和team_id分组），但它处理每个组内部的逻辑表达式。通过这种方式，我们通过将team1_off的逻辑输出与team2_off相乘来有效地得到team_id == max/min(team_id)和player_off。当两者都是1时，输出将为1，这意味着在所选团队中有1名玩家关闭。
现在我们有一个数据表：
> dt.1[,.(action_id,team2_off=(team_id==max(team_id))*player_off,team1_off=(team_id==min(team_id))*player_off,team_id,time_ref,player_off),by=game_id]
game_id action_id team2_off team1_off team_id time_ref player_off
1: 100 1 0 0 10 1000 0
2: 100 1 0 0 10 1001 0
3: 100 1 0 0 10 1002 0
4: 100 1 0 0 11 1003 0
5: 100 2 0 0 11 1004 0
6: 100 1 0 0 11 1005 0
7: 100 3 0 1 10 1006 1
8: 100 1 0 0 11 1007 0
9: 100 1 0 0 10 1008 0
10: 100 1 0 0 10 1009 0
11: 101 3 0 0 12 1000 0
12: 101 1 0 0 12 1001 0
13: 101 1 0 0 12 1002 0
14: 101 2 0 0 13 1003 0
15: 101 3 1 0 13 1004 1
16: 101 1 0 0 12 1005 0
17: 101 1 0 0 13 1006 0
18: 101 1 0 0 13 1007 0
19: 101 1 0 1 12 1008 1
20: 101 1 0 0 12 1009 0
现在我们不再需要按两组进行分组（team_id，game_id），我们可以通过cumsum做game_id，并且比较cumsum(team1_off)==cumsum(team2_off)，order，game_id和time_ref，因此结果将具有正确的顺序。
据我所知，在这种情况下，NAs可能与0有不同的含义。如果你真的非常关心，只需创建一个dummy列player_off。
> dt$dummy<-dt$player_off
> dt$dummy[is.na(dt$dummy)]<-0
> dt<-as.data.table(dt)
> dt[, .(
+ action_id,
+ team2_off = (team_id == max(team_id)) * dummy,
+ team1_off = (team_id == min(team_id)) * dummy,
+ team_id,
+ time_ref,
+ player_off
+ ), by = game_id][order(game_id, time_ref)][, .(team_id,
+ time_ref,
+ action_id,
+ player_off,
+ even = as.numeric(cumsum(team2_off) == cumsum(team1_off))), by = game_id]
game_id team_id time_ref action_id player_off even
1: 100 10 1000 1 NA 1
2: 100 10 1001 1 NA 1
3: 100 10 1002 1 NA 1
4: 100 11 1003 1 NA 1
5: 100 11 1004 2 NA 1
6: 100 11 1005 1 NA 1
7: 100 10 1006 3 1 0
8: 100 11 1007 1 NA 0
9: 100 10 1008 1 NA 0
10: 100 10 1009 1 NA 0
11: 101 12 1000 3 0 1
12: 101 12 1001 1 NA 1
13: 101 12 1002 1 NA 1
14: 101 13 1003 2 NA 1
15: 101 13 1004 3 1 0
16: 101 12 1005 1 NA 0
17: 101 13 1006 1 NA 0
18: 101 13 1007 1 NA 0
19: 101 12 1008 1 NA 0
20: 101 12 1009 1 NA 0
我认为你的问题非常有趣，我致力于使用data.table来解决这个问题。它花了我几个小时，我几乎放弃了data.table，认为data.table不能一次处理两个分组。我最终用逻辑乘法解决了它。
我有很大的乐趣
team1_off = (team_id == min(team_id)) * dummy
team2_off = (team_id == max(team_id)) * dummy