如何按顺序更新评级？
How to update a rating sequentially?
给定这个简单的数据集：
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 行吗？我的自定义函数似乎运行良好，我发现这里真正具有挑战性的是更新评分，因为球队不需要在主场和客场进行比赛：[的价值=48=]rating before 等于 rating after 上一场比赛的主场和客场比赛。
另请注意，每支球队的比赛数量不一定相同（这里例如 MIL 打了 6 场比赛，LAC 打了 4 场，其他球队打了 5 场）。
感谢任何愿意给我任何提示或帮助的人。
我们可以创建一个函数
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
给定这个简单的数据集：
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 行吗？我的自定义函数似乎运行良好，我发现这里真正具有挑战性的是更新评分，因为球队不需要在主场和客场进行比赛：[的价值=48=]rating before 等于 rating after 上一场比赛的主场和客场比赛。
另请注意，每支球队的比赛数量不一定相同（这里例如 MIL 打了 6 场比赛，LAC 打了 4 场，其他球队打了 5 场）。
感谢任何愿意给我任何提示或帮助的人。
我们可以创建一个函数
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