如何按顺序更新评分？答案

【问题标题】：How to update a rating sequentially?如何按顺序更新评分？
【发布时间】：2021-08-18 09:09:10
【问题描述】：

鉴于这个简单的数据集：

data <- data.frame(ID=seq(1:15),
                   H.team=c("GS","LAC","MIL","CHA","MIL","ATL","TOR","CHA","LAC","GS","TOR","MIL","ATL","CHA","TOR"),
                   A.team=c("MIL","CHA","TOR","ATL","GS","MIL","LAC","GS","TOR","ATL","CHA","LAC","GS","MIL","ATL"),
                   H.pts=c(94,120,91,84,88,96,93,95,113,85,101,116,86,102,90),
                   A.pts=c(84,107,99,75,90,105,87,99,94,87,92,106,84,89,89))
data
   ID H.team A.team H.pts A.pts
1   1     GS    MIL    94    84
2   2    LAC    CHA   120   107
3   3    MIL    TOR    91    99
4   4    CHA    ATL    84    75
5   5    MIL     GS    88    90
6   6    ATL    MIL    96   105
7   7    TOR    LAC    93    87
8   8    CHA     GS    95    99
9   9    LAC    TOR   113    94
10 10     GS    ATL    85    87
11 11    TOR    CHA   101    92
12 12    MIL    LAC   116   106
13 13    ATL     GS    86    84
14 14    CHA    MIL   102    89
15 15    TOR    ATL    90    89

我正在尝试为每个团队计算一个新的评分变量（rat），结果应该是：

   ID H.team A.team H.pts A.pts   h.rbef   a.rbef   h.raft   a.raft
1   1     GS    MIL    94    84 1500.000 1500.000 1508.487 1491.513
2   2    LAC    CHA   120   107 1500.000 1500.000 1510.021 1489.979
3   3    MIL    TOR    91    99 1491.513 1500.000 1481.066 1510.447
4   4    CHA    ATL    84    75 1489.979 1500.000 1498.279 1491.700
5   5    MIL     GS    88    90 1481.066 1508.487 1475.842 1513.711
6   6    ATL    MIL    96   105 1491.700 1475.842 1479.614 1487.928
7   7    TOR    LAC    93    87 1510.447 1510.021 1516.760 1503.708
8   8    CHA     GS    95    99 1498.279 1513.711 1491.164 1520.826
9   9    LAC    TOR   113    94 1503.708 1516.760 1517.357 1503.111
10 10     GS    ATL    85    87 1520.826 1479.614 1514.361 1486.079
11 11    TOR    CHA   101    92 1503.111 1491.164 1510.678 1483.597
12 12    MIL    LAC   116   106 1487.928 1517.357 1497.502 1507.783
13 13    ATL     GS    86    84 1486.079 1514.361 1490.516 1509.924
14 14    CHA    MIL   102    89 1483.597 1497.502 1494.213 1486.886
15 15    TOR    ATL    90    89 1510.678 1490.516 1513.711 1487.483

rat 的第一个值为每个团队的1500；

比赛结束后，rat的值更新如下：

rat.after=rat.before+k*(S-E)

其中 S = 1 如果球队获胜，否则为 0

E是比赛开始前的比赛获胜概率，由以下函数定义：

win.probs<- function(h.rbef, a.rbef, hca=64) {
  h = 10^(h.rbef/400)
  a = 10^(a.rbef/400)
  hca = 10^(hca/400)
  den = a + hca*h
  h.prob = hca*h / den
  a.prob = a / den
  return(c(h.prob,a.prob))
}
#example (not run): win.probs(1500,1500)

k 是一个移动常数，定义如下：

rat.k<- function(h.pts,a.pts,h.rbef,a.rbef) {
  ifelse(h.pts-a.pts>0,
         20*(h.pts-a.pts+3)^0.8/(7.5+0.006*(h.rbef-a.rbef)),
         20*(-(h.pts-a.pts)+3)^0.8/(7.5+0.006*(-(h.rbef-a.rbef))))
}
#example (not run): rat.k(94,84,1500,1500)

我写了以下更新函数，在单场比赛中效果很好：

up.rat<- function(h.pts, a.pts, h.rbef, a.rbef, hca=64) {
    h.prob = win.probs(h.rbef, a.rbef, hca)[1]
    a.prob = win.probs(h.rbef, a.rbef, hca)[2]
    h.win = ifelse(h.pts-a.pts>0,1,0)
    a.win = ifelse(h.pts-a.pts<0,1,0)
    k = rat.k(h.pts,a.pts,h.rbef,a.rbef)
    h.raft = h.rbef + k * (h.win - h.prob) 
    a.raft = a.rbef + k * (a.win - a.prob) 
  return(c(h.rbef,a.rbef,h.raft,a.raft))
}
#example (not run): up.rat(94,84,1500,1500)

并且，将它“手动”应用于我发现上面的结果的数据。例如第一场比赛是GS vs MIL：比赛前两队的评分都是1500，比赛结束后主队的评分是1508.487，而客队的评分是1491.513（这是一个零和评级）。所以GS 将以这个更新的评分开始下一场比赛，MIL 也是如此。

由于我的原始数据超过 15 行，有人可以帮我找到一种“自动”执行此操作的方法吗？我的自定义功能似乎运行良好，我发现这里真正具有挑战性的是更新评分，因为球队不需要在主场和客场进行比赛：rating 的值before 等于 rating after 上一场比赛的主客场比赛。另请注意，每支球队的比赛次数不必相同（例如，MIL 打了 6 场比赛，LAC 4 场，其他 5 场）。

感谢任何试图给我任何提示或帮助的人。

【问题讨论】：

哪个变量具有优先权？对于第 3 行，使用的值来自 a.raft 而在第 5 行，它是 h.raft
每一行都需要 h.raft 和 a.raft 来计算。此外，主场比赛的球队可以在主场或客场进行下一场比赛

标签： r for-loop apply rolling-computation accumulate

【解决方案1】：

我们可以创建一个函数

f1 <- function(dat, start_val) {
       dat[c("h.rbef", "a.rbef", "h.raft", "a.raft")] <- start_val
       for(i in seq_len(nrow(data))) {
       
    
        if(i == 1) {
    
           h.rbef <- dat$h.rbef[1]
           a.rbef <- dat$a.rbef[1]
    
    
        } else {
    
          hh.ind <- with(dat, tail(which(H.team[seq_len(i-1)] %in% H.team[i]), 1))
          ha.ind <- with(dat, tail(which(A.team[seq_len(i-1)] %in% H.team[i]), 1))  
      
          aa.ind <- with(dat, tail(which(A.team[seq_len(i-1)] %in% A.team[i]), 1))
          ah.ind <- with(dat, tail(which(H.team[seq_len(i-1)] %in% A.team[i]), 1))
      
          if(length(hh.ind) > 0 & length(ha.ind) > 0 ) {
               ix <- which.max(c(hh.ind, ha.ind))
               mx <- max(hh.ind, ha.ind)
               if(ix == 1) {
                 h.rbef <- dat$h.raft[mx]
           
               } else {
                 h.rbef <- dat$a.raft[mx]
           
               }
      
          } else {
        
                 if(length(hh.ind) > 0) {
            
                 h.rbef <- dat$h.raft[hh.ind]
      
                }   else if(length(ha.ind) > 0) {
            
                 h.rbef <- dat$a.raft[ha.ind]
      
                } else {
      
                 h.rbef <- dat$h.rbef[i]
               }
          }
      
          if(length(aa.ind) > 0 & length(ah.ind) > 0 ) {
               iy <- which.max(c(aa.ind, ah.ind))
               my <- max(aa.ind, ah.ind)
               if(iy == 1) {
                 a.rbef <- dat$a.raft[my]
           
               } else {
                 a.rbef <- dat$h.raft[my]
           
               }
      
          } else {
      
            if(length(aa.ind) > 0) {
      
               a.rbef <- dat$a.raft[aa.ind]
      
                }   else if(length(ah.ind) > 0) {
      
                 a.rbef <- dat$h.raft[ah.ind]
      
                } else {
      
                 a.rbef <- dat$a.rbef[i]
             }
             }
      
      
      
      
    
        }    
    
    
           tmp <- up.rat(dat$H.pts[i], dat$A.pts[i], h.rbef, a.rbef)
            dat[i, c("h.rbef", "a.rbef", "h.raft", "a.raft")] <- tmp
       }
       return(dat)


}

-测试

out <- f1(data, 1500)

-输出

out
#   ID H.team A.team H.pts A.pts   h.rbef   a.rbef   h.raft   a.raft
#1   1     GS    MIL    94    84 1500.000 1500.000 1508.487 1491.513
#2   2    LAC    CHA   120   107 1500.000 1500.000 1510.021 1489.979
#3   3    MIL    TOR    91    99 1491.513 1500.000 1481.066 1510.447
#4   4    CHA    ATL    84    75 1489.979 1500.000 1498.279 1491.700
#5   5    MIL     GS    88    90 1481.066 1508.487 1475.842 1513.711
#6   6    ATL    MIL    96   105 1491.700 1475.842 1479.614 1487.928
#7   7    TOR    LAC    93    87 1510.447 1510.021 1516.760 1503.708
#8   8    CHA     GS    95    99 1498.279 1513.711 1491.164 1520.826
#9   9    LAC    TOR   113    94 1503.708 1516.760 1517.357 1503.111
#10 10     GS    ATL    85    87 1520.826 1479.614 1514.361 1486.079
#11 11    TOR    CHA   101    92 1503.111 1491.164 1510.678 1483.597
#12 12    MIL    LAC   116   106 1487.928 1517.357 1497.501 1507.783
#13 13    ATL     GS    86    84 1486.079 1514.361 1490.516 1509.924
#14 14    CHA    MIL   102    89 1483.597 1497.501 1494.214 1486.885
#15 15    TOR    ATL    90    89 1510.678 1490.516 1513.710 1487.484

【讨论】：

抱歉回复晚了，非常感谢！！！绝妙的解决方案......你就是男人！！！！