Nothing
elo_scores<- function (winners, losers, identities = NULL, sigmoid.param = 1/100,
K = 200, init.score = 0, randomise = FALSE, n.rands = 1000,
return.as.ranks = FALSE, return.trajectories = FALSE, dates = NULL){
if (is.null(identities)) {
identities <- unique(c(winners, losers))
}
n.inds <- length(identities)
if (randomise == FALSE) {
n.rands <- 1
} else if (!is.null(dates)) {
stop("Cannot randomise and keep dates consistent")
}
if (sum(c(winners, losers) %in% identities) < length(c(winners, losers))) {
stop("Not all winners and/or losers are contained in identities")
}
T <- length(winners)
if (return.trajectories) {
if (randomise == TRUE) {
all.scores <- array(init.score, c(n.inds, T + 1, n.rands))
} else {
all.scores <- array(init.score, c(n.inds, T + 1))
if(!(is.null(dates))){ #newly implemented if statement
dates.character <- as.character(dates)
all.dated.scores <- array(init.score, c(n.inds, length(unique(dates.character))),dimnames = list(identities,unique(dates.character)))
}
}
} else {
all.scores <- array(init.score, c(n.inds, n.rands))
}
rownames(all.scores) <- identities
if (length(K) == 1) {
K <- rep(K, T)
}
for (r in 1:n.rands) {
if (randomise == FALSE) {
ord <- 1:T
} else {
ord <- sample(1:T, T, replace = F)
}
winners.perm <- winners[ord]
losers.perm <- losers[ord]
if(!(is.null(dates))){ #newly implemented if statement
dates.perm <- dates.character[ord]
dated.scores <- array(NA, c(n.inds, length(unique(dates.character))),dimnames = list(identities,unique(dates.character)))
}
scores <- array(NA, c(n.inds, T + 1))
scores[, 1] <- init.score
for (i in 1:T) {
scores[, i + 1] <- scores[, i]
winner <- which(identities == winners.perm[i])
loser <- which(identities == losers.perm[i])
if(!(is.null(dates))){ #newly implemented if statement
date <- which(dates.character == dates.perm[i])
}
p <- 1/(1 + exp(-sigmoid.param * abs((scores[winner, i] - scores[loser, i]))))
if (scores[winner, i] >= scores[loser, i]) {
scores[winner, i + 1] <- scores[winner, i] +
(1 - p) * K[i]
scores[loser, i + 1] <- scores[loser, i] - (1 - p) * K[i]
if(!(is.null(dates))){ #newly implemented if statement
dated.scores[winner,dates.perm[i]] <- scores[winner, i] + (1 - p) * K[i]
dated.scores[loser,dates.perm[i]] <- scores[loser, i] - (1 - p) * K[i]
}
} else {
scores[winner, i + 1] <- scores[winner, i] + p * K[i]
scores[loser, i + 1] <- scores[loser, i] - p * K[i]
if(!(is.null(dates))){ #newly implemented if statement
dated.scores[winner,dates.perm[i]] <- scores[winner, i] + p * K[i]
dated.scores[loser,dates.perm[i]] <- scores[loser, i] - p * K[i]
}
}
}
if (return.trajectories) {
if (randomise == TRUE) {
all.scores[, , r] <- scores
} else {
all.scores <- scores
if(!(is.null(dates))){ #newly implemented if statement
all.dated.scores <- dated.scores
}
}
} else {
all.scores[, r] <- scores[, T + 1]
}
}
freq <- table(factor(c(winners, losers), levels = identities))
if (length(dim(all.scores))==3) {
all.scores[which(identities %in% names(freq)[which(freq == 0)]), , ] <- NA
} else {
all.scores[which(identities %in% names(freq)[which(freq == 0)]), ] <- NA
}
if(!(is.null(dates))){#newly implemented if statement
all.dated.scores[which(identities %in% names(freq)[which(freq == 0)]), ] <- NA
invisible(all.dated.scores)
} else {
if (return.as.ranks == TRUE) {
all.ranks <- apply(all.scores, 2, function(x) {rank(-x)})
all.ranks[is.na(all.scores)] <- NA
all.scores <- all.ranks
}
invisible(all.scores)
}
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.