R语言高效计算学生累计平均考试成绩及最新成绩的方法问询

我正在用R做数据分析，手里有一份学生考试数据集，包含学生ID、考试年份和考试结果（var_1=1表示通过，var_1=0表示不通过）：

library(dplyr)

my_data = data.frame(id = c(1,1,1,1,2,2,2,3,4,4,5,5,5,5,5),
 year = c(2010,2011,2012,2013, 2011, 2012, 2013, 2013, 2014, 2015, 2015, 2016, 2017, 2018, 2019),var_1 = c(1 ,1 ,0 ,1 ,1 ,0 ,0 ,0, 1, 0, 1, 1, 0, 1, 1))

需求说明 #

需要生成一个新数据集，包含每个学生截至倒数第二次考试的累计平均成绩，以及最新一次考试的成绩（用于后续预测下一次结果），同时要忽略只参加过一次考试的学生。

我自己写了一段实现代码，但效率不高：

# create a grouped rank variable (per ID) to track the order of exams 
my_data = my_data %>% arrange(id, year) %>%
    group_by(id) %>% 
    mutate(rank = rank(-year))

# separate the most recent exams (int_file_1) and all other exams (int_file_2) 
int_file_1 = my_data[my_data$rank == 1,]
int_file_2 = my_data[my_data$rank != 1,]

# for each student, calculate cumulative averages
int_file_3  = int_file_2  %>% group_by(id) %>% mutate(Cumulative_Mean = cummean(var_1))


# for each student, select the row corresponding to last exam (this is actually second last exam in whole dataset)
int_file_4 = int_file_3 %>% 
   group_by(id) %>% 
   slice_min(order_by = rank)


# join previous files together
join = merge(x = int_file_4, y = int_file_1, by = "id", all.x = TRUE)

# drop unnecessary columns and rename columns
colnames(join)[1] <- "id"
colnames(join)[2] <- "second_most_recent_year"
colnames(join)[3] <- "second_most_recent_exam"
colnames(join)[5] <- "cumulative_exam_score_up_to_second_most_recent_exam"
colnames(join)[7] <- "most_recent_exam_score"

join = join[,c(1,2,3,5,7)]

这段代码能得到预期结果：

head(join)
  id second_most_recent_year second_most_recent_exam cumulative_exam_score_up_to_second_most_recent_exam most_recent_exam_score
1  1                    2012                       0                                           0.6666667                      1
2  2                    2012                       0                                           0.5000000                      0

高效实现方案 #

可以用dplyr的链式操作，合并步骤，减少中间数据集的创建，同时利用窗口函数直接定位所需数据：

library(dplyr)
library(tidyr) # 需要用到pivot_wider

result <- my_data %>%
  # 按学生ID和年份排序，确保考试顺序从早到晚
  arrange(id, year) %>%
  group_by(id) %>%
  # 过滤掉仅参加1次考试的学生
  filter(n() >= 2) %>%
  # 计算考试顺序、累计平均分，标记最新和倒数第二次考试
  mutate(
    exam_order = row_number(),
    cum_mean = cummean(var_1),
    is_most_recent = exam_order == max(exam_order),
    is_second_last = exam_order == max(exam_order) - 1
  ) %>%
  # 只保留需要的两行数据
  filter(is_second_last | is_most_recent) %>%
  # 转宽格式合并为单行
  pivot_wider(
    id_cols = id,
    names_from = is_most_recent,
    values_from = c(year, var_1, cum_mean),
    # 自定义列名
    names_glue = "{case_when(
      .value == 'cum_mean' ~ 'cumulative_exam_score_up_to_second_most_recent_exam',
      is_most_recent ~ str_c('most_recent_', .value),
      TRUE ~ str_c('second_most_recent_', .value)
    )}"
  ) %>%
  # 整理列顺序并重命名
  select(
    id,
    second_most_recent_year,
    second_most_recent_var_1,
    cumulative_exam_score_up_to_second_most_recent_exam,
    most_recent_var_1
  ) %>%
  rename(
    second_most_recent_exam = second_most_recent_var_1,
    most_recent_exam_score = most_recent_var_1
  )

# 查看结果
head(result)

方案优势 #

• 全程链式操作，无需创建多个中间数据集，减少内存占用和代码冗余
• 用row_number()替代rank(-year)，逻辑更直接，避免同一年份考试的排名冲突
• 直接通过filter(n() >=2)过滤不符合要求的学生，步骤简洁
• 用pivot_wider一步完成行转列，替代后续的合并和列名修改操作，代码更紧凑

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