基于R语言计算学生连续两次挂科后下次挂科的概率
2026-8-9
问题描述与代码修正需求
数据集构造
现有学生多次考试的数据集，考试结果为通过（"1"）或挂科（"0"），数据集构造代码如下：
id = sample.int(10000, 100000, replace = TRUE) res = c(1,0) results = sample(res, 100000, replace = TRUE) date_exam_taken = sample(seq(as.Date('1999/01/01'), as.Date('2020/01/01'), by="day"), 100000, replace = TRUE) my_data = data.frame(id, results, date_exam_taken) my_data <- my_data[order(my_data$id, my_data$date_exam_taken),] my_data$general_id = 1:nrow(my_data) my_data$exam_number = ave(my_data$general_id, my_data$id, FUN = seq_along) my_data$general_id = NULL
数据集结构示例：
id results date_exam_taken exam_number 7992 1 1 2004-04-23 1 24837 1 0 2004-12-10 2 12331 1 1 2007-01-19 3 34396 1 0 2007-02-21 4 85250 1 0 2007-09-26 5 11254 1 1 2009-12-20 6
已实现的一级分析
已完成单次考试结果后下次考试的概率计算，代码及结果如下：
my_list = list() for (i in 1:length(unique(my_data$id))) { {tryCatch({ start_i = my_data[my_data$id == i,] pairs_i = data.frame(first = head(start_i$results, -1), second = tail(start_i$results, -1)) frame_i = as.data.frame(table(pairs_i)) frame_i$id = i my_list[[i]] = frame_i }, error = function(e){}) }} final = do.call(rbind.data.frame, my_list) library(dplyr) total_1 = final %>% group_by(first, second) %>% summarise(totals = n()) total_2 = total_1 %>% group_by(first) %>% summarise(sum = sum(totals)) join = merge(x = total_1, y = total_2, by = "first", all = TRUE) join$probs = join$totals/join$sum
结果示例：
first second totals sum probs 1 0 0 9817 19557 0.5019686 2 0 1 9740 19557 0.4980314 3 1 0 9727 19498 0.4988717 4 1 1 9771 19498 0.5011283
二级分析需求
需要计算连续两次考试结果后，第三次考试的概率（例如：学生第3、4次考试挂科，求第5次挂科的概率），预期结果格式：
first second third totals sums probs 1 1 1 1 ... ... ... 2 0 0 0 ... ... ... 3 1 0 1 ... ... ... 4 0 1 0 ... ... ... 5 0 0 1 ... ... ... 6 1 1 0 ... ... ... 7 0 1 1 ... ... ... 8 1 0 0 ... ... ...
错误的尝试代码及问题
尝试的代码得到了完全均匀的概率结果（所有probs为0.5），明显不符合预期，代码如下：
library(stringr) my_list = list() for (i in 1:length(unique(my_data$id))) { {tryCatch({ start_i = my_data[my_data$id == i,] vals_i = as.numeric(paste(start_i$results, collapse = "")) L_1_i = lengths(gregexpr("111", vals_i)) L_2_i = lengths(gregexpr("000", vals_i)) L_3_i = lengths(gregexpr("101", vals_i)) L_4_i = lengths(gregexpr("010", vals_i)) L_5_i = lengths(gregexpr("001", vals_i)) L_6_i = lengths(gregexpr("110", vals_i)) L_7_i = lengths(gregexpr("011", vals_i)) L_8_i = lengths(gregexpr("100", vals_i)) frame_i = data.frame(class = c("111","000","101","010","001","110","011","100"), values = c(L_1_i, L_2_i, L_3_i, L_4_i, L_5_i, L_6_i, L_7_i, L_8_i)) frame_i$id = i my_list[[i]] = frame_i }, error = function(e){}) }} final = do.call(rbind.data.frame, my_list) final$first = substr(final$class, 1,1) final$second = substr(final$class, 2,2) final$third = substr(final$class, 3,3) total_1 = final %>% group_by(first, second, third) %>% summarise(totals = n()) total_2 = total_1 %>% group_by(first, second) %>% summarise(sum = sum(totals)) join = merge(x = total_1, y = total_2, by = c("first", "second"), all = TRUE) join$probs = join$totals/join$sum
错误结果示例：
first second third totals sum probs 1 0 0 0 10000 20000 0.5 2 0 0 1 10000 20000 0.5 3 0 1 0 10000 20000 0.5 4 0 1 1 10000 20000 0.5 5 1 0 0 10000 20000 0.5 6 1 0 1 10000 20000 0.5 7 1 1 0 10000 20000 0.5 8 1 1 1 10000 20000 0.5
原代码错误分析
- 字符串拼接损坏数据：
as.numeric(paste(start_i$results, collapse = ""))会将长序列转换为科学计数法，导致原始考试结果字符串完全失真，正则匹配完全失效。 - 正则匹配计数错误：
gregexpr默认非重叠匹配，例如"1111"中"111"只会被统计1次，但实际存在2个连续三元组（位置1-3、2-4），计数严重偏低。 - 统计逻辑错误：
summarise(totals = n())统计的是出现该三元组的学生数量，而非所有学生的三元组总次数，这是导致结果完全均匀的核心原因。
修正后的代码实现
方法一：使用dplyr分组滑动窗口（高效简洁）
library(dplyr) # 按学生分组，生成连续三元组（前两次结果 + 当前结果） triples_data <- my_data %>% group_by(id) %>% # 仅保留考试次数>=3的学生数据 filter(n() >= 3) %>% mutate( first = lag(results, 2), # 前两次考试结果 second = lag(results, 1), # 前一次考试结果 third = results # 当前考试结果 ) %>% # 过滤掉没有足够前序数据的行 filter(!is.na(first)) %>% ungroup() # 统计各三元组的总出现次数 total_triples <- triples_data %>% group_by(first, second, third) %>% summarise(totals = n(), .groups = "drop") # 统计每个(first, second)组合的总次数 total_pairs <- total_triples %>% group_by(first, second) %>% summarise(sum = sum(totals), .groups = "drop") # 合并计算概率 final_result <- merge(total_triples, total_pairs, by = c("first", "second")) %>% mutate(probs = totals / sum) %>% arrange(first, second, third) # 查看结果 print(final_result)
方法二：修正循环逻辑（保留原循环思路）
my_list <- list() # 遍历每个唯一学生ID for (i in unique(my_data$id)) { tryCatch({ start_i <- my_data[my_data$id == i, ] # 仅处理考试次数>=3的学生 if (nrow(start_i) >= 3) { # 直接按位置截取生成三元组 triples_i <- data.frame( first = start_i$results[1:(nrow(start_i)-2)], second = start_i$results[2:(nrow(start_i)-1)], third = start_i$results[3:nrow(start_i)] ) # 统计当前学生的三元组次数 frame_i <- as.data.frame(table(triples_i)) frame_i$id <- i my_list[[as.character(i)]] <- frame_i } }, error = function(e){}) } final <- do.call(rbind.data.frame, my_list) # 统计所有学生的三元组总次数 total_1 <- final %>% group_by(first, second, third) %>% summarise(totals = sum(Freq), .groups = "drop") # 统计每个(first, second)组合的总次数 total_2 <- total_1 %>% group_by(first, second) %>% summarise(sum = sum(totals), .groups = "drop") # 合并计算概率 join <- merge(total_1, total_2, by = c("first", "second")) %>% mutate(probs = totals / sum) %>% arrange(first, second, third) # 查看结果 print(join)
内容的提问来源于stack exchange，提问作者stats_noob
相关产品推荐
相关产品推荐
