我的数据如下：
a1 a2 a3 a4 a5 h1 h2 h3 h4 h5 a.evt.score h.evt.score
3311 4003 2737 3784 4177 2632 726 633 438 5444 0 1
1696 371 4471 2119 274 1947 5745 3622 438 5444 1 0
1696 371 4471 1199 2230 1947 5745 3622 5034 4166 1 0
3191 4471 2737 274 2230 3598 633 5034 5444 3485 1 0
3191 3685 3486 3784 4177 2632 726 633 438 5444 0 1
127 713 1609 5444 4166 3311 371 4471 1199 2230 1 0
127 713 1609 2345 3485 1696 4003 2737 1199 2230 1 0
127 713 1609 2345 3485 1696 4003 2737 1199 2230 1 0
1947 5745 3622 438 5444 3311 371 4471 3784 4177 1 0
2632 726 633 5444 4166 3191 3685 3486 274 2230 0 1
2632 726 633 438 5444 3191 3685 3486 3784 4177 0 1
5745 3598 5198 4166 3485 1696 4003 2737 274 2230 0 1
2632 726 633 2345 5034 3311 371 4471 3784 4177 1 0
127 3859 726 438 5444 1696 4003 2737 2119 274 1 0
2632 713 633 5034 4166 3191 3685 3486 3784 4177 1 0
a1，a2，a3 ......，h4，h5列中的数字是玩家的唯一ID。 （a1，...，a5）在“客场”球队打球，（h1，...，h5）是他们的对手。
每一行都是游戏中的一个事件。
“a.evt.score”表示客队是否“赢得”了比赛。
我想，对于每个玩家，在数据中的每个事件（行）之后计算他的Elo评级。
用于计算玩家评分的公式为：
R _new = R _old + k * （得分 - 预期 ）
如果球队赢得比赛，“得分”为1，如果没有则为0。
设k为30（表示每个事件对整体评分的影响程度）。
让每个玩家都以2200的R_old开始。
“预期”，我用公式计算（假设我们正在看球队的球员1）：
h.R <- c(h1.R, h2.R, h3.R, h4.R, h5.R)
a1.E <- sum(1/(1+10^((h.R - a1.R)/400)))/5
所以，a1的新评级是：
a1.R <- a1.R + 30*(a.evt.score - a1.E)
我希望我的最终结果是每个玩家的矢量， 他们的Elo评级历史。
因此，对于数据中的每一行，我想：
我遇到的问题是当我进入循环/应用函数时，我无法弄清楚如何从命名变量（给定玩家的Elo历史向量）中提取值（R_old），或者如何将计算的评级附加到变量。
我怎样才能做到以上几点？
答案 0 :(得分：2)
我最好的选择，可能还有改进的空间。
主要想法是建立一个玩家列表，其中一个玩家ID条目存储玩家得分历史记录。
新分数计算是在一个单独的函数中完成的，也许我没有得到你想要做的。我希望我发表评论足以解释发生了什么。
k<-30
ateam<-paste0("a",1:5)
hteam<-paste0("h",1:5)
playersid <- unique(unname( unlist( datas[, c(ateam,hteam) ] ) ))
scores=as.list(rep(2200,length(playersid)))
names(scores)<-playersid
getPlayerScore <- function(player,team_score,opponents_scores) {
old_score <- scores[[as.character(player)]][1]
expect <- sum(1/10^((opponents_scores - old_score)/400))/5
return(old_score + k*(team_score - expect))
}
updateTeamPlayersScore<-function(row,team) {
opteam<-ifelse(team=="a","h","a") # get the team we're against
players <- unlist(row[get(paste0(team,"team"))]) # get the players list
opponents <- unlist(row[get(paste0(opteam,"team"))]) # get the oppenents list
# Get the oppents scores
opponents_score <- sapply(scores[as.character(opponents)],function(x) { x[[1]] } )
# loop over the players and return the list of updated scores
r<-lapply(players,function(x) {
new_score <- getPlayerScore(x,as.numeric(row[paste0(team,".evt.score")]),opponents_score)
c(new_score,scores[[as.character(x)]])
})
# Update the list names
names(r) <- as.character(opponents)
r # return the new scores list
}
# loop over the rows.
# The update is done after calculation to avoid side-effect on h scores with updated a scores
for (i in 1:nrow(datas)) {
row <- datas[i,]
# Get updated scores for team a
new_a <- updateTeamPlayersScore(row,"a")
# Get updated scores for team h
new_h <- updateTeamPlayersScore(row,"h")
# update team 'a' scores
scores[names(new_a)] <- new_a
# update team 'h' scores
scores[names(new_h)] <- new_h
}
结果
> head(scores)
$`3311`
[1] 2124.757 2119.203 2111.189 2136.164 2165.133 2200.000
$`1696`
[1] 2135.691 2135.032 2170.030 2168.635 2200.000 2200.000
$`3191`
[1] 2142.342 2141.330 2176.560 2174.560 2170.000 2200.000
$`127`
[1] 2098.406 2123.018 2158.292 2193.603 2200.000
$`1947`
[1] 2158.292 2193.603 2200.000
$`2632`
[1] 2100.837 2132.849 2168.509 2173.636 2170.000 2200.000
使用的数据：
datas<-read.table(text=" a1 a2 a3 a4 a5 h1 h2 h3 h4 h5 a.evt.score h.evt.score
3311 4003 2737 3784 4177 2632 726 633 438 5444 0 1
1696 371 4471 2119 274 1947 5745 3622 438 5444 1 0
1696 371 4471 1199 2230 1947 5745 3622 5034 4166 1 0
3191 4471 2737 274 2230 3598 633 5034 5444 3485 1 0
3191 3685 3486 3784 4177 2632 726 633 438 5444 0 1
127 713 1609 5444 4166 3311 371 4471 1199 2230 1 0
127 713 1609 2345 3485 1696 4003 2737 1199 2230 1 0
127 713 1609 2345 3485 1696 4003 2737 1199 2230 1 0
1947 5745 3622 438 5444 3311 371 4471 3784 4177 1 0
2632 726 633 5444 4166 3191 3685 3486 274 2230 0 1
2632 726 633 438 5444 3191 3685 3486 3784 4177 0 1
5745 3598 5198 4166 3485 1696 4003 2737 274 2230 0 1
2632 726 633 2345 5034 3311 371 4471 3784 4177 1 0
127 3859 726 438 5444 1696 4003 2737 2119 274 1 0
2632 713 633 5034 4166 3191 3685 3486 3784 4177 1 0",header=T)
答案 1 :(得分：1)
我建立并维护每个活动后每个玩家的评级的单独运行列表。这样你可以在下一个事件中引用它进行计算。
首先，加载所有数据，参数和包。
library(tidyr)
library(dplyr)
crosstab <- read.table(header=T,
text=" a1 a2 a3 a4 a5 h1 h2 h3 h4 h5 a.evt.score h.evt.score
3311 4003 2737 3784 4177 2632 726 633 438 5444 0 1
1696 371 4471 2119 274 1947 5745 3622 438 5444 1 0
1696 371 4471 1199 2230 1947 5745 3622 5034 4166 1 0
3191 4471 2737 274 2230 3598 633 5034 5444 3485 1 0
3191 3685 3486 3784 4177 2632 726 633 438 5444 0 1
127 713 1609 5444 4166 3311 371 4471 1199 2230 1 0
127 713 1609 2345 3485 1696 4003 2737 1199 2230 1 0
127 713 1609 2345 3485 1696 4003 2737 1199 2230 1 0
1947 5745 3622 438 5444 3311 371 4471 3784 4177 1 0
2632 726 633 5444 4166 3191 3685 3486 274 2230 0 1
2632 726 633 438 5444 3191 3685 3486 3784 4177 0 1
5745 3598 5198 4166 3485 1696 4003 2737 274 2230 0 1
2632 726 633 2345 5034 3311 371 4471 3784 4177 1 0
127 3859 726 438 5444 1696 4003 2737 2119 274 1 0
2632 713 633 5034 4166 3191 3685 3486 3784 4177 1 0")
#parameters
k <- 30
seed.rating <- 2200 # default used if a player is not found on ratings table
接下来，两个本地帮助函数进行期望计算。
# calculate expected win against an opponent
calcExpect <- function(rating, opp.rating) {
return(1/(1+10^((opp.rating-rating)/400)))
}
# calculate average expectation of a player against all opponents in current event
compileExpect <- function(id) {
rowno <- which(roster$playerid==id)
opp <- roster %>% filter(ah!=roster$ah[rowno])
all.expected <- sapply(opp$rating,
function(x) calcExpect(roster$rating[rowno], x))
return(mean(all.expected))
}
然后设置在每个事件之后更新的列表（即评级列表，并且可选地在每个事件之后结果）。在这里，我们从一个空的评级列表开始，但如果您有一个现有的评级列表，您可以轻松地从该数据框开始作为列表中的第一个元素。
# start with a blank rating list; can always start with the latest ELO table
ratings <- list(data.frame(playerid=integer(0), rating=numeric(0)))
# optional for logging result for every round, for error checking
rosters <- NULL
现在主要是：遍历整个事件数据，即crosstab并处理每个事件，在每个事件后在ratings（以及可选rosters）中创建一个条目。
你会注意到，在我建立名单后，我没有不同的代码行来计算“a”或“h”队员的评分或期望值。这应该使这个代码更容易适应有超过2个团队（例如联盟）的事件。
for (i in seq_len(nrow(crosstab))) {
# get latest ratings
elo <- as.data.frame(tail(ratings, 1))
# take one row of data corresponding to an event
event <- crosstab[i, ]
# spread the row into a player roster
roster <- event %>% gather(key=no, value=playerid, a1:h5) %>%
mutate(ah = substr(no, 1, 1), # away or home team
score = ifelse(ah=="a", a.evt.score, h.evt.score)) %>% #win or lose
select(playerid, ah, score) %>%
left_join(elo) # get current rating
# unrated players assigned base rating
roster$rating[is.na(roster$rating)] <- seed.rating
# calculate expected and new ratings of event participants
roster$expected <- sapply(roster$playerid, compileExpect)
roster$new.rating <- with(roster, rating + k*(score-expected))
# calculate new overall ratings
new.ratings <- roster %>% select(playerid, new.rating) %>%
rename(rating=new.rating) %>%
rbind(elo) %>%
filter(!duplicated(playerid)) # remove old ratings of player
#update ratings
ratings <- c(ratings, list(new.ratings))
# Optional for error checking: update log of result every round
rosters <- c(rosters, list(roster))
}
输出将是包含16个元素的列表ratings，以及包含15个元素的rosters。 ratings中的元素x是事件编号x之前的，而rosters中的元素x是事件编号x后的结果。
我们以例如事件2（即表格中的第二行）为例。
> rosters[[2]]
playerid ah score rating expected new.rating
1 1696 a 1 2200 0.4913707 2215.259
2 371 a 1 2200 0.4913707 2215.259
3 4471 a 1 2200 0.4913707 2215.259
4 2119 a 1 2200 0.4913707 2215.259
5 274 a 1 2200 0.4913707 2215.259
6 1947 h 0 2200 0.5000000 2185.000
7 5745 h 0 2200 0.5000000 2185.000
8 3622 h 0 2200 0.5000000 2185.000
9 438 h 0 2215 0.5215733 2199.353
10 5444 h 0 2215 0.5215733 2199.353
初步检查似乎一切都井然有序：8名没有参加比赛的球员的首发得分为2200，之前获胜球队的两名球员的评分为＆gt; 2200.球队“h”中新球员的期望为0.5，因为他们的得分与球队“a”中的所有球员相同（都是新人）。
赛事2之后的评分将是赛事3之前的评分（包括赛事1和赛事2的参赛者）：
> ratings[[3]]
playerid rating
1 438 2199.353
2 1947 2185.000
3 2632 2215.000
4 2119 2215.259
5 3622 2185.000
6 3311 2185.000
7 4003 2185.000
8 726 2215.000
9 5444 2215.000
10 1696 2215.259
11 371 2215.259
12 274 2215.259
13 3784 2185.000
14 4471 2215.259
15 4177 2185.000
16 5745 2185.000
17 633 2215.000
18 2737 2185.000
最后，ratings[[16]]中共有33名评级玩家，这些玩家应该匹配表格中唯一玩家编号的总数。
编辑：我错过了所需的输出是玩家评分历史的向量（感谢@Tensibai指出了这一点）。为此，我创建了一个辅助函数来通过他的id来提取任何玩家的历史记录。
getPlayerHistory <- function(id) {
# pull all ratings of the player
temp <- lapply(ratings, function(x) x$rating[x$playerid==id])
# coerce into vector with same length as the list, forcing parts with no values into NA
vec <- do.call(c, lapply(temp, function(x) {length(x) <- 1; return(x)}))
return(vec)
}
你可以直接打电话，例如
getPlayerHistory("5034")
[1] NA NA NA 2185.395 2171.403 2171.403 2171.403 2171.403 2171.403
[10] 2171.403 2171.403 2171.403 2171.403 2186.862 2186.862 2202.293
请注意，此向量中有16个值，因为它们在事件之前是。所以第一个NA是因为没有开始评级，接下来的两个NA是因为玩家“5034”在事件3中第一次玩，所以可用的第一个评级是在事件4之前。当玩家没有参加比赛时，他的评分保持不变。
您可以使用辅助功能将整个评级历史记录拉入列表。
idList <- tail(ratings, 1)[[1]]$playerid # get the latest ratings list
ratList <- lapply(idList, getPlayerHistory)
names(ratList) <- idList
然后你可以通过调用列表来获得相同的结果。
> ratList[["5034"]]
[1] NA NA NA 2185.395 2171.403 2171.403 2171.403 2171.403 2171.403
[10] 2171.403 2171.403 2171.403 2171.403 2186.862 2186.862 2202.293