网球共同对手R脚本优化需求：提升15万行数据集计算效率

我目前在跟进一篇关于网球共同对手的论文，核心目标是写出最高效的R计算脚本，但现在遇到了大麻烦：当前代码单场比赛计算耗时约120秒，而我需要处理的数据集足足有15万行，这样的效率完全无法完成任务，恳请各位帮忙优化！

代码背景 #

我的代码基于论文中的模型逻辑，用到了三个数据集（tableA、tableB、data_tennis_co），核心是计算两名选手的共同对手得分均值。但目前大量的循环和冗余操作拖垮了速度，急需优化思路。

当前低效代码 #

data_tennis_co = read.table("test_co.csv", header=FALSE, sep=",", fill = TRUE)
A = read.table("tableA.csv", header=FALSE, sep=",", fill = TRUE)
B = read.table("tableB.csv", header=FALSE, sep=",", fill = TRUE)

# 基础计算函数
G <- function(p) {
  res <- p^4 * (15 - 4*p - ((10*p^2)/(1 - 2*p*(1-p))))
}

d <- function(p, q) {
  res <- p*q / (1 - (p*(1-q) + (1-p)*q))
}

TB <- function(p, q) {
  res <- foreach(i = seq_along(1:28), .combine = sum) %dopar% {
    tb <- A[i,1] * p^A[i,2] * (1-p)^A[i,3] * q^A[i,4] * (1-q)^A[i,5] * d(p,q)^A[i,6]
  }
}

S <- function(p, q) {
  res <- foreach(i = seq_along(1:21), .combine = rbind) %dopar% {
    s <- B[i,1] * G(p)^B[i,2] * (1-G(p))^B[i,3] * G(q)^B[i,4] * (1-G(q))^B[i,5] * 
      (G(p)*G(q) + (G(p)*(1-G(q)) + (1-G(p))*G(q))*TB(p,q))^B[i,6]
  }
  sum(res)
}

M3 <- function(p, q) {
  res <- S(p,q)^2 * (1 + 2*(1 - S(p,q)))
}

DELTA_AB <- function(spwAC, rpwAC, spwBC, rpwBC) {
  res <- (spwAC - (1 - rpwAC)) - (spwBC - (1 - rpwBC))
}

PR <- function(spwAC, rpwAC, spwBC, rpwBC) {
  delta <- DELTA_AB(spwAC, rpwAC, spwBC, rpwBC)
  res <- (M3(0.6 + delta, 0.4) + M3(0.6, 1 - (0.6 - delta))) / 2
}

# 共同对手计算核心函数
MAL <- function(id1, id2) {
  prova <- subset(data_tennis_co, V3 == id1 & V4 == id2)
  previous <- subset(data_tennis_co, V2 < prova$V2)
  
  s1 <- subset(previous, V3 == id1 | V4 == id1)
  s1$opp <- ifelse(s1$V3 == id1, s1$V4, s1$V3)
  
  s2 <- subset(previous, V3 == id2 | V4 == id2)
  s2$opp <- ifelse(s2$V3 == id2, s2$V4, s2$V3)
  
  inn <- intersect(s1$opp, s2$opp)
  common1 <- s1[s1$opp %in% inn, ]
  common2 <- s2[s2$opp %in% inn, ]
  
  COM <- merge(common1, common2, by = "opp")
  COM$OMALLEY <- unlist(mapply(PR, COM$V5.x, COM$V6.x, COM$V7.y, COM$V8.y))
  COM$OMALLEY[is.nan(COM$OMALLEY)] <- 0.5
  
  return(tryCatch(sum(COM$OMALLEY)/nrow(COM), error = function(e) NaN))
}

# 测试耗时
tic()
RESA <- MAL(1,2)
toc()

希望优化的方向 #

我自己猜测问题可能出在foreach的滥用、重复计算（比如TB(p,q)在S里被多次调用）、数据子集操作的低效这些点上，但不知道具体怎么改。希望各位能帮忙：

• 清理冗余代码，简化计算逻辑
• 把循环改成向量运算，避免不必要的并行开销
• 提升数据筛选、合并的效率
• 任何能降低单场计算时间的建议都可以！

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