基于Dplyr按条件对dataframe滚动计算刺激历史选择的累积平均outcome

假设我有如下dataframe：

stim1  stim2    choice  outcome   Feedback
1     2     1      0       0           1
2     3     2      1       1           1
3     2     3      1       0           1
4     2     3      0       1           1

我的目标是逐行更新stim1和stim2两个字段的对应统计值：计算该刺激在之前所有被选中试次中的outcome累积平均值，规则如下：

• choice=0 代表stim1被选中
• choice=1 代表stim2被选中

具体算法逻辑：
a) 对指定刺激，找到所有之前的试次满足 (stim1等于该刺激 & choice=0) | (stim2等于该刺激 & choice=1)
b) 计算符合条件试次的outcome平均值

举个例子：第4行试次的stim1是2，它的历史平均值计算如下：

• 试次1：2作为stim1，choice=0被选中，outcome=0，计入
• 试次2：2作为stim2，choice=1被选中，outcome=1，计入
• 试次3：2作为stim1，choice=1未被选中，不计入
• 最终平均值为 (0+1)/2 = 1/2

stim1  stim2 choice  outcome Feedback    Observed_Stim1   Observed_Stim2
1     2     1      0       0     1            NaN              NaN
2     3     2      1       1     1            NaN               0
3     2     3      1       0     1            1/2              NaN
4     2     3      1       1     1            1/2               0

目前用循环实现的代码逻辑如下：

data$trial=1:NROW(data)
data$relative_stim1=rep(NaN, nrow(data))
data$relative_stim2=rep(NaN, nrow(data))
for (i in 2:nrow(data)){
      
      data$relative_stim1[i]=mean(data$outcome[which((data$stim1==data$stim1[i]&data$choice==0&data$feedback==1& data$trial<data$trial[i])) | (data$stim2==data$stim1[i]&data$choice==1&data$feedback==1& data$trial<data$trial[i]))])
      data$relative_stim2[i]=mean(data$outcome[which((data$stim1==data$stim2[i]&data$choice==0&data$feedback==1& data$trial<data$trial[i])) | (data$stim2==data$stim2[i]&data$choice==1&data$feedback==1& data$trial<data$trial[i]))])
}

先把数据转为长格式，按刺激分组计算滚动累积平均值，再合并回原宽表即可，性能远高于逐行循环：

library(dplyr)
library(tidyr)

df <- df %>% mutate(trial = row_number())

# 生成每个试次被选中刺激的对应outcome记录
df_long <- df %>%
  filter(Feedback == 1) %>%
  mutate(selected_stim = ifelse(choice == 0, stim1, stim2)) %>%
  select(trial, selected_stim, outcome)

# 按刺激分组计算历史平均值
stim_history <- df_long %>%
  group_by(selected_stim) %>%
  # 用cummean加lag取当前行之前的所有行的均值
  mutate(cum_mean = lag(cummean(outcome), n = 1)) %>%
  ungroup()

# 把历史均值匹配回原表的stim1和stim2字段
result <- df %>%
  left_join(stim_history, by = c("trial" = "trial", "stim1" = "selected_stim")) %>%
  rename(Observed_Stim1 = cum_mean) %>%
  left_join(stim_history, by = c("trial" = "trial", "stim2" = "selected_stim")) %>%
  rename(Observed_Stim2 = cum_mean) %>%
  select(-trial, -outcome.y, -outcome) %>%
  rename(outcome = outcome.x)

内容的提问来源于stack exchange，提问作者user15791858