R:为团队游戏实施 Elo 评级;在循环中为多个变量赋值
R: Implementing Elo ratings for team game; assigning values to multiple variables from within a loop
我有这样的数据:
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)在"away"队打球,(h1, ..., h5)是他们的对手。
每一行都是游戏中的一个事件。
"a.evt.score"表示客队是否"won"赛事
我想为每个玩家在数据中的每个事件(行)后计算他的 Elo 评分。
用于计算玩家评分的公式为:
R_new = R_old + k*(分数 - 预期)
如果球队赢得比赛,"Score" 为 1,否则为 0。
设 k 为 30(表示每个事件对整体评分的影响程度)。
并让每位玩家的初始 R_old 为 2200。
"Expected",我用公式计算(假设我们正在看客队球员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.
- 对于每个玩家,根据事件的结果计算一个新的 Elo。
- 将这个新评级 (R_new) 附加到每个玩家历史向量的开头。
我 运行 遇到的问题是当我无法弄清楚如何从命名变量(给定玩家的 Elo 历史向量)中提取值 (R_old) 时'm 在 loop/apply 函数中,或者如何将计算出的评分附加到变量。
我怎样才能完成上述操作?
我最好的选择,可能还有改进的余地。
主要思想是建立一个玩家列表,其中一个条目由玩家 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)
我建立并维护了一个单独的 运行 列表,其中列出了每个玩家在每场比赛后的评分。这样就可以在下次活动中参考计算了。
首先,加载所有数据、参数和包。
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 是 before 事件编号 x 中的元素 x,而 rosters
中的元素 x 是 after 事件的结果数字 x.
让我们以事件 2 为例(即 table 中的第二行)。
> 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名早前未上场的选手起始rating为2200,2名早前在获胜队伍中的选手rating > 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 名被评分的球员,这应该与您的 table.
中唯一球员号码的总数相匹配
编辑: 我错过了所需的输出是玩家评级历史的向量(感谢@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
我有这样的数据:
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)在"away"队打球,(h1, ..., h5)是他们的对手。
每一行都是游戏中的一个事件。
"a.evt.score"表示客队是否"won"赛事
我想为每个玩家在数据中的每个事件(行)后计算他的 Elo 评分。
用于计算玩家评分的公式为:
R_new = R_old + k*(分数 - 预期)
如果球队赢得比赛,"Score" 为 1,否则为 0。
设 k 为 30(表示每个事件对整体评分的影响程度)。
并让每位玩家的初始 R_old 为 2200。
"Expected",我用公式计算(假设我们正在看客队球员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.
- 对于每个玩家,根据事件的结果计算一个新的 Elo。
- 将这个新评级 (R_new) 附加到每个玩家历史向量的开头。
我 运行 遇到的问题是当我无法弄清楚如何从命名变量(给定玩家的 Elo 历史向量)中提取值 (R_old) 时'm 在 loop/apply 函数中,或者如何将计算出的评分附加到变量。
我怎样才能完成上述操作?
我最好的选择,可能还有改进的余地。
主要思想是建立一个玩家列表,其中一个条目由玩家 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)
我建立并维护了一个单独的 运行 列表,其中列出了每个玩家在每场比赛后的评分。这样就可以在下次活动中参考计算了。
首先,加载所有数据、参数和包。
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 是 before 事件编号 x 中的元素 x,而 rosters
中的元素 x 是 after 事件的结果数字 x.
让我们以事件 2 为例(即 table 中的第二行)。
> 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名早前未上场的选手起始rating为2200,2名早前在获胜队伍中的选手rating > 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 名被评分的球员,这应该与您的 table.
编辑: 我错过了所需的输出是玩家评级历史的向量(感谢@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