├── tests ├── testthat.R └── testthat │ ├── test_specials.R │ ├── helper-data.R │ ├── test_elo.winpct.R │ ├── test_elo.run.multiteam.R │ ├── test_elo.markovchain.R │ ├── test_elo.model.frame.R │ ├── test_elo_functions.R │ ├── test_auxiliary.R │ ├── test_elo.glm.R │ └── test_elo.team.R ├── data ├── tournament.rda └── tournament.multiteam.rda ├── docs ├── reference │ └── Rplot001.png ├── pkgdown.yml ├── articles │ ├── intro_files │ │ ├── header-attrs-2.11 │ │ │ └── header-attrs.js │ │ └── accessible-code-block-0.0.1 │ │ │ └── empty-anchor.js │ ├── running_elos_files │ │ ├── header-attrs-2.11 │ │ │ └── header-attrs.js │ │ └── accessible-code-block-0.0.1 │ │ │ └── empty-anchor.js │ ├── comparison_methods_files │ │ ├── header-attrs-2.11 │ │ │ └── header-attrs.js │ │ └── accessible-code-block-0.0.1 │ │ │ └── empty-anchor.js │ ├── elo_files │ │ └── accessible-code-block-0.0.1 │ │ │ └── empty-anchor.js │ └── index.html ├── link.svg ├── bootstrap-toc.css ├── docsearch.js ├── pkgdown.js ├── bootstrap-toc.js ├── authors.html └── 404.html ├── .gitignore ├── .Rbuildignore ├── cran-comments.md ├── elo.Rproj ├── R ├── tournament.multiteam.R ├── tournament.R ├── mov.R ├── score.R ├── RcppExports.R ├── elo.R ├── elo.update.R ├── fitted.R ├── rank.teams.R ├── mse.R ├── auc.R ├── elo.calc.R ├── favored.R ├── elo.players.R ├── elo.run.multiteam.R ├── elo.prob.R ├── eloRun2.R ├── elo.run.helpers.R ├── summary.R ├── elo.winpct.R ├── elo.glm.R ├── elo.run.R ├── elo.colley.R ├── elo.markovchain.R ├── elo.model.frame.R └── predict.R ├── man ├── tournament.multiteam.Rd ├── elo.mov.Rd ├── tournament.Rd ├── score.Rd ├── elo.Rd ├── fitted.elo.Rd ├── rank.teams.Rd ├── elo.mse.Rd ├── auc.elo.Rd ├── favored.elo.Rd ├── elo.model.frame.Rd ├── summary.elo.Rd ├── elo.calc.Rd ├── elo.update.Rd ├── elo.run.helpers.Rd ├── elo.run.multiteam.Rd ├── elo.prob.Rd ├── elo.winpct.Rd ├── predict.elo.Rd ├── elo.glm.Rd ├── elo.colley.Rd ├── elo.markovchain.Rd ├── elo.run.Rd └── formula.specials.Rd ├── src ├── finalElos.cpp ├── winPct.cpp ├── colley.cpp ├── markovChain.cpp ├── asMatrix.cpp └── elo.cpp ├── _pkgdown.yml ├── DESCRIPTION ├── README.md ├── data-raw └── tournament.R ├── vignettes ├── players.Rmd └── intro.Rmd └── NAMESPACE /tests/testthat.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(elo) 3 | 4 | test_check("elo") 5 | -------------------------------------------------------------------------------- /data/tournament.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/eheinzen/elo/HEAD/data/tournament.rda -------------------------------------------------------------------------------- /docs/reference/Rplot001.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/eheinzen/elo/HEAD/docs/reference/Rplot001.png -------------------------------------------------------------------------------- /data/tournament.multiteam.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/eheinzen/elo/HEAD/data/tournament.multiteam.rda -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | .Ruserdata 5 | *.o 6 | *.so 7 | *.dll 8 | inst/doc 9 | renv 10 | renv.lock 11 | .Renviron 12 | .Rprofile 13 | -------------------------------------------------------------------------------- /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^renv$ 2 | ^renv\.lock$ 3 | ^.*\.Rproj$ 4 | ^\.Rproj\.user$ 5 | ^\.travis\.yml$ 6 | ^cran-comments\.md$ 7 | ^_pkgdown\.yml$ 8 | ^docs$ 9 | ^pkgdown$ 10 | ^data-raw$ 11 | -------------------------------------------------------------------------------- /docs/pkgdown.yml: -------------------------------------------------------------------------------- 1 | pandoc: 2.11.4 2 | pkgdown: 1.6.1 3 | pkgdown_sha: ~ 4 | articles: 5 | comparison_methods: comparison_methods.html 6 | intro: intro.html 7 | running_elos: running_elos.html 8 | last_built: 2022-02-03T15:49Z 9 | 10 | -------------------------------------------------------------------------------- /cran-comments.md: -------------------------------------------------------------------------------- 1 | ## Submission for elo 3.0.1 2 | 3 | This is a resubmission to fix a comment noted by CRAN vis-a-vis the package man page. 4 | 5 | ## Test environments 6 | 7 | * R 4.2.2 (local Linux install) 8 | 9 | * Debian, Fedora, Ubuntu: R release with Rhub (using `devtools::check_rhub()`) 10 | 11 | * win-builder (devel, release, and old release) 12 | 13 | ## R CMD check results 14 | 15 | 0 errors | 0 warnings | 0 notes 16 | -------------------------------------------------------------------------------- /elo.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: Default 4 | SaveWorkspace: Default 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: Sweave 13 | LaTeX: pdfLaTeX 14 | 15 | AutoAppendNewline: Yes 16 | StripTrailingWhitespace: Yes 17 | 18 | BuildType: Package 19 | PackageUseDevtools: Yes 20 | PackageInstallArgs: --no-multiarch --with-keep.source 21 | -------------------------------------------------------------------------------- /tests/testthat/test_specials.R: -------------------------------------------------------------------------------- 1 | context("Testing the special functions") 2 | 3 | 4 | # k 5 | 6 | expect_identical(k(1:10, 2:11), k(k(1:10, 2:11))) 7 | expect_identical(is.na(k(1:10)), rep(FALSE, 10)) 8 | expect_identical(is.na(k(c(1:9, NA))), c(rep(FALSE, 9), TRUE)) 9 | expect_identical(is.na(k(1:10, 2:11)), rep(FALSE, 10)) 10 | expect_identical(is.na(k(c(1:9, NA), 2:11)), c(rep(FALSE, 9), TRUE)) 11 | 12 | expect_identical(k(1:10)[1:4], k(1:4)) 13 | expect_identical(k(1:10, 2:11)[1:4], k(1:4, 2:5)) 14 | -------------------------------------------------------------------------------- /docs/articles/intro_files/header-attrs-2.11/header-attrs.js: -------------------------------------------------------------------------------- 1 | // Pandoc 2.9 adds attributes on both header and div. We remove the former (to 2 | // be compatible with the behavior of Pandoc < 2.8). 3 | document.addEventListener('DOMContentLoaded', function(e) { 4 | var hs = document.querySelectorAll("div.section[class*='level'] > :first-child"); 5 | var i, h, a; 6 | for (i = 0; i < hs.length; i++) { 7 | h = hs[i]; 8 | if (!/^h[1-6]$/i.test(h.tagName)) continue; // it should be a header h1-h6 9 | a = h.attributes; 10 | while (a.length > 0) h.removeAttribute(a[0].name); 11 | } 12 | }); 13 | -------------------------------------------------------------------------------- /docs/articles/running_elos_files/header-attrs-2.11/header-attrs.js: -------------------------------------------------------------------------------- 1 | // Pandoc 2.9 adds attributes on both header and div. We remove the former (to 2 | // be compatible with the behavior of Pandoc < 2.8). 3 | document.addEventListener('DOMContentLoaded', function(e) { 4 | var hs = document.querySelectorAll("div.section[class*='level'] > :first-child"); 5 | var i, h, a; 6 | for (i = 0; i < hs.length; i++) { 7 | h = hs[i]; 8 | if (!/^h[1-6]$/i.test(h.tagName)) continue; // it should be a header h1-h6 9 | a = h.attributes; 10 | while (a.length > 0) h.removeAttribute(a[0].name); 11 | } 12 | }); 13 | -------------------------------------------------------------------------------- /docs/articles/comparison_methods_files/header-attrs-2.11/header-attrs.js: -------------------------------------------------------------------------------- 1 | // Pandoc 2.9 adds attributes on both header and div. We remove the former (to 2 | // be compatible with the behavior of Pandoc < 2.8). 3 | document.addEventListener('DOMContentLoaded', function(e) { 4 | var hs = document.querySelectorAll("div.section[class*='level'] > :first-child"); 5 | var i, h, a; 6 | for (i = 0; i < hs.length; i++) { 7 | h = hs[i]; 8 | if (!/^h[1-6]$/i.test(h.tagName)) continue; // it should be a header h1-h6 9 | a = h.attributes; 10 | while (a.length > 0) h.removeAttribute(a[0].name); 11 | } 12 | }); 13 | -------------------------------------------------------------------------------- /R/tournament.multiteam.R: -------------------------------------------------------------------------------- 1 | #' \code{tournament.multiteam}: Mock data for examples 2 | #' 3 | #' A fake dataset containing results from "animal-ball" matches. 4 | #' 5 | #' @format A data frame with 56 observations on the following 4 variables: 6 | #' \describe{ 7 | #' \item{\code{week}}{Week Number} 8 | #' \item{\code{half}}{The half of the season in which the match was played} 9 | #' \item{\code{Place_1}}{The first-place team} 10 | #' \item{\code{Place_2}}{The second-place team} 11 | #' \item{\code{Place_3}}{The third-place team} 12 | #' \item{\code{Place_4}}{The fourth-place team} 13 | #' } 14 | #' @name tournament.multiteam 15 | NULL 16 | #> NULL 17 | -------------------------------------------------------------------------------- /docs/articles/elo_files/accessible-code-block-0.0.1/empty-anchor.js: -------------------------------------------------------------------------------- 1 | // Hide empty tag within highlighted CodeBlock for screen reader accessibility (see https://github.com/jgm/pandoc/issues/6352#issuecomment-626106786) --> 2 | // v0.0.1 3 | // Written by JooYoung Seo (jooyoung@psu.edu) and Atsushi Yasumoto on June 1st, 2020. 4 | 5 | document.addEventListener('DOMContentLoaded', function() { 6 | const codeList = document.getElementsByClassName("sourceCode"); 7 | for (var i = 0; i < codeList.length; i++) { 8 | var linkList = codeList[i].getElementsByTagName('a'); 9 | for (var j = 0; j < linkList.length; j++) { 10 | if (linkList[j].innerHTML === "") { 11 | linkList[j].setAttribute('aria-hidden', 'true'); 12 | } 13 | } 14 | } 15 | }); 16 | -------------------------------------------------------------------------------- /docs/articles/intro_files/accessible-code-block-0.0.1/empty-anchor.js: -------------------------------------------------------------------------------- 1 | // Hide empty tag within highlighted CodeBlock for screen reader accessibility (see https://github.com/jgm/pandoc/issues/6352#issuecomment-626106786) --> 2 | // v0.0.1 3 | // Written by JooYoung Seo (jooyoung@psu.edu) and Atsushi Yasumoto on June 1st, 2020. 4 | 5 | document.addEventListener('DOMContentLoaded', function() { 6 | const codeList = document.getElementsByClassName("sourceCode"); 7 | for (var i = 0; i < codeList.length; i++) { 8 | var linkList = codeList[i].getElementsByTagName('a'); 9 | for (var j = 0; j < linkList.length; j++) { 10 | if (linkList[j].innerHTML === "") { 11 | linkList[j].setAttribute('aria-hidden', 'true'); 12 | } 13 | } 14 | } 15 | }); 16 | -------------------------------------------------------------------------------- /docs/articles/running_elos_files/accessible-code-block-0.0.1/empty-anchor.js: -------------------------------------------------------------------------------- 1 | // Hide empty tag within highlighted CodeBlock for screen reader accessibility (see https://github.com/jgm/pandoc/issues/6352#issuecomment-626106786) --> 2 | // v0.0.1 3 | // Written by JooYoung Seo (jooyoung@psu.edu) and Atsushi Yasumoto on June 1st, 2020. 4 | 5 | document.addEventListener('DOMContentLoaded', function() { 6 | const codeList = document.getElementsByClassName("sourceCode"); 7 | for (var i = 0; i < codeList.length; i++) { 8 | var linkList = codeList[i].getElementsByTagName('a'); 9 | for (var j = 0; j < linkList.length; j++) { 10 | if (linkList[j].innerHTML === "") { 11 | linkList[j].setAttribute('aria-hidden', 'true'); 12 | } 13 | } 14 | } 15 | }); 16 | -------------------------------------------------------------------------------- /R/tournament.R: -------------------------------------------------------------------------------- 1 | #' \code{tournament}: Mock data for examples 2 | #' 3 | #' A fake dataset containing results from "animal-ball" matches. 4 | #' 5 | #' @format A data frame with 56 observations on the following 4 variables: 6 | #' \describe{ 7 | #' \item{\code{team.Home}}{The home team for the match} 8 | #' \item{\code{team.Visitor}}{The visiting team for the match} 9 | #' \item{\code{points.Home}}{Number of points scored by the home team} 10 | #' \item{\code{points.Visitor}}{Number of points scored by the visiting team} 11 | #' \item{\code{week}}{Week Number} 12 | #' \item{\code{half}}{The half of the season in which the match was played} 13 | #' } 14 | #' @examples 15 | #' data(tournament) 16 | #' str(tournament) 17 | #' @name tournament 18 | NULL 19 | #> NULL 20 | -------------------------------------------------------------------------------- /docs/articles/comparison_methods_files/accessible-code-block-0.0.1/empty-anchor.js: -------------------------------------------------------------------------------- 1 | // Hide empty tag within highlighted CodeBlock for screen reader accessibility (see https://github.com/jgm/pandoc/issues/6352#issuecomment-626106786) --> 2 | // v0.0.1 3 | // Written by JooYoung Seo (jooyoung@psu.edu) and Atsushi Yasumoto on June 1st, 2020. 4 | 5 | document.addEventListener('DOMContentLoaded', function() { 6 | const codeList = document.getElementsByClassName("sourceCode"); 7 | for (var i = 0; i < codeList.length; i++) { 8 | var linkList = codeList[i].getElementsByTagName('a'); 9 | for (var j = 0; j < linkList.length; j++) { 10 | if (linkList[j].innerHTML === "") { 11 | linkList[j].setAttribute('aria-hidden', 'true'); 12 | } 13 | } 14 | } 15 | }); 16 | -------------------------------------------------------------------------------- /man/tournament.multiteam.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/tournament.multiteam.R 3 | \name{tournament.multiteam} 4 | \alias{tournament.multiteam} 5 | \title{\code{tournament.multiteam}: Mock data for examples} 6 | \format{ 7 | A data frame with 56 observations on the following 4 variables: 8 | \describe{ 9 | \item{\code{week}}{Week Number} 10 | \item{\code{half}}{The half of the season in which the match was played} 11 | \item{\code{Place_1}}{The first-place team} 12 | \item{\code{Place_2}}{The second-place team} 13 | \item{\code{Place_3}}{The third-place team} 14 | \item{\code{Place_4}}{The fourth-place team} 15 | } 16 | } 17 | \description{ 18 | A fake dataset containing results from "animal-ball" matches. 19 | } 20 | -------------------------------------------------------------------------------- /src/finalElos.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | using namespace Rcpp; 3 | 4 | bool anyZero(NumericVector x) 5 | { 6 | for(int i = 0; i < x.size(); i++) 7 | { 8 | if(x[i] == 0) 9 | { 10 | return true; 11 | } 12 | } 13 | return false; 14 | } 15 | 16 | // [[Rcpp::export]] 17 | NumericVector finalElos(NumericMatrix mat, int nTeams) 18 | { 19 | int nBoth = (mat.ncol() - 4) / 2; 20 | NumericVector out(nTeams); 21 | for(int row = mat.nrow() - 1; row > -1; row--) 22 | { 23 | for(int j = 0; j < nBoth; j++) 24 | { 25 | double tm = mat(row, j) - 1; 26 | if(tm >= 0 && out[tm] == 0) 27 | { 28 | out[tm] = mat(row, nBoth + 4 + j); 29 | } 30 | } 31 | 32 | if(!anyZero(out)) 33 | { 34 | return out; 35 | } 36 | } 37 | return out; 38 | } 39 | 40 | 41 | 42 | -------------------------------------------------------------------------------- /docs/link.svg: -------------------------------------------------------------------------------- 1 | 2 | 3 | 5 | 8 | 12 | 13 | -------------------------------------------------------------------------------- /man/elo.mov.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/mov.R 3 | \name{elo.mov} 4 | \alias{elo.mov} 5 | \alias{mov} 6 | \title{Create a "margin of victory" column} 7 | \usage{ 8 | mov(score.A, score.B = 0) 9 | } 10 | \arguments{ 11 | \item{score.A}{Numeric; the score of the first team. Alternatively, this can 12 | be a pre-computed margin of victory which will get compared to 0.} 13 | 14 | \item{score.B}{Numeric; the score of the second team; default is 0, in case 15 | \code{score.A} is already a margin of victory..} 16 | } 17 | \value{ 18 | An object with class \code{"elo.mov"}, denoting \code{score.A} = \code{score.B}. 19 | } 20 | \description{ 21 | Create a "margin of victory" based on two teams' scores 22 | } 23 | \examples{ 24 | mov(12, 10) 25 | mov(10, 10) 26 | mov(10, 12) 27 | } 28 | \seealso{ 29 | \code{\link{score}} 30 | } 31 | -------------------------------------------------------------------------------- /man/tournament.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/tournament.R 3 | \name{tournament} 4 | \alias{tournament} 5 | \title{\code{tournament}: Mock data for examples} 6 | \format{ 7 | A data frame with 56 observations on the following 4 variables: 8 | \describe{ 9 | \item{\code{team.Home}}{The home team for the match} 10 | \item{\code{team.Visitor}}{The visiting team for the match} 11 | \item{\code{points.Home}}{Number of points scored by the home team} 12 | \item{\code{points.Visitor}}{Number of points scored by the visiting team} 13 | \item{\code{week}}{Week Number} 14 | \item{\code{half}}{The half of the season in which the match was played} 15 | } 16 | } 17 | \description{ 18 | A fake dataset containing results from "animal-ball" matches. 19 | } 20 | \examples{ 21 | data(tournament) 22 | str(tournament) 23 | } 24 | -------------------------------------------------------------------------------- /src/winPct.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | using namespace Rcpp; 3 | 4 | 5 | // [[Rcpp::export]] 6 | List eloWinPct(NumericVector winsA, NumericMatrix teamA, NumericMatrix teamB, 7 | NumericVector weightsA, NumericVector weightsB, NumericVector weights, int nTeams) { 8 | NumericVector out(nTeams), N_i(nTeams); 9 | int ncolA = teamA.ncol(), ncolB = teamB.ncol(); 10 | 11 | for(int i = 0; i < winsA.size(); i++) 12 | { 13 | for(int j = 0; j < ncolA; j++) 14 | { 15 | double tmA = teamA(i, j); 16 | out[tmA] += weights[i]*weightsA[j]*winsA[i]; 17 | N_i[tmA] += weights[i]*weightsA[j]; 18 | } 19 | 20 | for(int j = 0; j < ncolB; j++) 21 | { 22 | double tmB = teamB(i, j); 23 | out[tmB] += weights[i]*weightsB[j]*(1.0 - winsA[i]); 24 | N_i[tmB] += weights[i]*weightsB[j]; 25 | } 26 | } 27 | 28 | return List::create(out / N_i, N_i); 29 | } 30 | 31 | -------------------------------------------------------------------------------- /man/score.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/score.R 3 | \name{score} 4 | \alias{score} 5 | \alias{is.score} 6 | \title{Create a 1/0/0.5 win "indicator"} 7 | \usage{ 8 | score(score.A, score.B) 9 | 10 | is.score(x) 11 | } 12 | \arguments{ 13 | \item{score.A}{Numeric; the score of the first team (whose wins are to be denoted by 1).} 14 | 15 | \item{score.B}{Numeric; the score of the second team (whose wins are to be denoted by 0).} 16 | 17 | \item{x}{An R object.} 18 | } 19 | \value{ 20 | For \code{score}, a vector containing 0, 1, and 0.5 (for ties). For 21 | \code{is.score}, \code{TRUE} or \code{FALSE} depending on whether all values of 22 | \code{x} are between 0 and 1 (inclusive). 23 | } 24 | \description{ 25 | Create a 1/0/0.5 win "indicator" based on two teams' scores, and test for "score-ness". 26 | } 27 | \examples{ 28 | score(12, 10) 29 | score(10, 10) 30 | score(10, 12) 31 | } 32 | \seealso{ 33 | \code{\link{score}} 34 | } 35 | -------------------------------------------------------------------------------- /R/mov.R: -------------------------------------------------------------------------------- 1 | 2 | #' Create a "margin of victory" column 3 | #' 4 | #' Create a "margin of victory" based on two teams' scores 5 | #' 6 | #' @param score.A Numeric; the score of the first team. Alternatively, this can 7 | #' be a pre-computed margin of victory which will get compared to 0. 8 | #' @param score.B Numeric; the score of the second team; default is 0, in case 9 | #' \code{score.A} is already a margin of victory.. 10 | #' @return An object with class \code{"elo.mov"}, denoting \code{score.A} = \code{score.B}. 11 | #' @seealso \code{\link{score}} 12 | #' @examples 13 | #' mov(12, 10) 14 | #' mov(10, 10) 15 | #' mov(10, 12) 16 | #' @name elo.mov 17 | NULL 18 | #> NULL 19 | 20 | #' @rdname elo.mov 21 | #' @export 22 | mov <- function(score.A, score.B = 0) 23 | { 24 | out <- score.A - score.B 25 | structure(out, class = c("elo.mov", class(out)[class(out) != "elo.mov"])) 26 | } 27 | 28 | #' @export 29 | `[.elo.mov` <- function(x, i) 30 | { 31 | out <- NextMethod() 32 | mov(out) 33 | } 34 | -------------------------------------------------------------------------------- /man/elo.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/elo.R 3 | \docType{package} 4 | \name{elo} 5 | \alias{elo} 6 | \alias{elo-package} 7 | \title{The Elo Package} 8 | \description{ 9 | An implementation of Elo ratings for general use in 'R'. 10 | } 11 | \section{Functions}{ 12 | 13 | 14 | Listed below are the most useful functions available in \code{elo}: 15 | 16 | \code{\link{elo.prob}}: Calculate the probability that team A beats team B. 17 | 18 | \code{\link{elo.update}}: Calculate the update value for a given Elo matchup. 19 | 20 | \code{\link{elo.calc}}: Calculate post-update Elo values. 21 | 22 | \code{\link{elo.run}}: Calculate Elos for a series of matches. 23 | 24 | \code{\link{score}}: Create a 1/0/0.5 win "indicator" based on two teams' scores. 25 | } 26 | 27 | \section{Data}{ 28 | 29 | 30 | \code{\link{tournament}}: Mock data for examples. 31 | } 32 | 33 | \examples{ 34 | library(elo) 35 | } 36 | \references{ 37 | Elo, A. E. 1978. The Rating of Chess Players, Past and Present. New York: Arco. 38 | } 39 | -------------------------------------------------------------------------------- /_pkgdown.yml: -------------------------------------------------------------------------------- 1 | destination: docs 2 | reference: 3 | - title: "Basic Elo Calculations" 4 | contents: 5 | - elo.prob 6 | - elo.update 7 | - elo.calc 8 | - title: "Running Elo Calculations" 9 | contents: 10 | - elo.run 11 | - elo.run.multiteam 12 | - title: Formula Specials 13 | contents: 14 | - k 15 | - mov 16 | - score 17 | - title: "Comparison Methods" 18 | contents: 19 | - elo.glm 20 | - elo.winpct 21 | - elo.markovchain 22 | - elo.colley 23 | - title: "Model Assessment" 24 | contents: 25 | - auc.elo 26 | - mse 27 | - favored 28 | - rank.teams 29 | - summary.elo 30 | - fitted.elo 31 | - predict.elo 32 | - title: "Other helpful utilities" 33 | contents: 34 | - final.elos 35 | - tournament 36 | - tournament.multiteam 37 | - elo.model.frame 38 | - elo 39 | 40 | articles: 41 | - title: "Vignettes" 42 | navbar: ~ 43 | contents: 44 | - intro 45 | - running_elos 46 | - comparison_methods 47 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: elo 2 | Version: 3.0.2.9000 3 | Title: Ranking Teams by Elo Rating and Comparable Methods 4 | Date: 2023-10-04 5 | Authors@R: c( 6 | person("Ethan", "Heinzen", email = "heinzen.ethan@mayo.edu", role = c("aut", "cre")) 7 | ) 8 | Description: A flexible framework for calculating Elo ratings and resulting 9 | rankings of any two-team-per-matchup system (chess, sports leagues, 'Go', 10 | etc.). This implementation is capable of evaluating a variety of matchups, 11 | Elo rating updates, and win probabilities, all based on the basic Elo 12 | rating system. It also includes methods to benchmark performance, 13 | including logistic regression and Markov chain models. 14 | Depends: 15 | R (>= 3.6.0), 16 | stats 17 | Imports: 18 | Rcpp, 19 | pROC 20 | Suggests: 21 | knitr, 22 | testthat, 23 | rmarkdown 24 | VignetteBuilder: knitr 25 | License: GPL (>= 2) 26 | URL: https://github.com/eheinzen/elo, https://cran.r-project.org/package=elo, https://eheinzen.github.io/elo/ 27 | BugReports: https://github.com/eheinzen/elo/issues 28 | RoxygenNote: 7.2.3 29 | LazyData: true 30 | LinkingTo: Rcpp 31 | Encoding: UTF-8 32 | -------------------------------------------------------------------------------- /R/score.R: -------------------------------------------------------------------------------- 1 | 2 | #' Create a 1/0/0.5 win "indicator" 3 | #' 4 | #' Create a 1/0/0.5 win "indicator" based on two teams' scores, and test for "score-ness". 5 | #' 6 | #' @param score.A Numeric; the score of the first team (whose wins are to be denoted by 1). 7 | #' @param score.B Numeric; the score of the second team (whose wins are to be denoted by 0). 8 | #' @param x An R object. 9 | #' @return For \code{score}, a vector containing 0, 1, and 0.5 (for ties). For 10 | #' \code{is.score}, \code{TRUE} or \code{FALSE} depending on whether all values of 11 | #' \code{x} are between 0 and 1 (inclusive). 12 | #' @seealso \code{\link{score}} 13 | #' @examples 14 | #' score(12, 10) 15 | #' score(10, 10) 16 | #' score(10, 12) 17 | #' @name score 18 | NULL 19 | #> NULL 20 | 21 | #' @rdname score 22 | #' @export 23 | score <- function(score.A, score.B) 24 | { 25 | (score.A > score.B) + 0.5*(score.A == score.B) 26 | } 27 | 28 | #' @rdname score 29 | #' @export 30 | is.score <- function(x) 31 | { 32 | is.numeric(x) && !anyNA(x) && all(0 <= x & x <= 1) 33 | } 34 | 35 | validate_score <- function(x) 36 | { 37 | if(!is.score(x)) stop("The wins should be between 0 and 1 (inclusive).") 38 | invisible(x) 39 | } 40 | -------------------------------------------------------------------------------- /man/fitted.elo.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/fitted.R 3 | \name{fitted.elo} 4 | \alias{fitted.elo} 5 | \alias{fitted.elo.run} 6 | \alias{residuals.elo.run} 7 | \alias{fitted.elo.running} 8 | \alias{fitted.elo.glm} 9 | \alias{fitted.elo.markovchain} 10 | \alias{fitted.elo.winpct} 11 | \alias{fitted.elo.colley} 12 | \title{Extract model values} 13 | \usage{ 14 | \method{fitted}{elo.run}(object, ...) 15 | 16 | \method{residuals}{elo.run}(object, ...) 17 | 18 | \method{fitted}{elo.running}(object, running = TRUE, ...) 19 | 20 | \method{fitted}{elo.glm}(object, ...) 21 | 22 | \method{fitted}{elo.markovchain}(object, ...) 23 | 24 | \method{fitted}{elo.winpct}(object, ...) 25 | 26 | \method{fitted}{elo.colley}(object, ...) 27 | } 28 | \arguments{ 29 | \item{object}{An object.} 30 | 31 | \item{...}{Other arguments} 32 | 33 | \item{running}{logical, denoting whether to use the running predicted values.} 34 | } 35 | \value{ 36 | A vector of fitted values. For running values, it has an additional attribute denoting to which 37 | group (i.e., which model) the prediction belongs 38 | } 39 | \description{ 40 | Extract model values from \code{elo} functions. 41 | } 42 | -------------------------------------------------------------------------------- /man/rank.teams.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/rank.teams.R 3 | \name{rank.teams} 4 | \alias{rank.teams} 5 | \alias{rank.teams.elo.run} 6 | \alias{rank.teams.elo.run.regressed} 7 | \alias{rank.teams.elo.glm} 8 | \alias{rank.teams.elo.markovchain} 9 | \alias{rank.teams.elo.winpct} 10 | \alias{rank.teams.elo.colley} 11 | \title{Rank teams} 12 | \usage{ 13 | rank.teams(object, ties.method = "min", ...) 14 | 15 | \method{rank.teams}{elo.run}(object, ties.method = "min", ...) 16 | 17 | \method{rank.teams}{elo.run.regressed}(object, ties.method = "min", regressed = FALSE, ...) 18 | 19 | \method{rank.teams}{elo.glm}(object, ties.method = "min", ...) 20 | 21 | \method{rank.teams}{elo.markovchain}(object, ties.method = "min", ...) 22 | 23 | \method{rank.teams}{elo.winpct}(object, ties.method = "min", ...) 24 | 25 | \method{rank.teams}{elo.colley}(object, ties.method = "min", ...) 26 | } 27 | \arguments{ 28 | \item{object}{An object.} 29 | 30 | \item{ties.method}{Passed to \code{\link{rank}}.} 31 | 32 | \item{...}{Other arguments} 33 | 34 | \item{regressed}{Passed to \code{\link{final.elos}}.} 35 | } 36 | \description{ 37 | Extract the rankings from Elo objects. 38 | } 39 | -------------------------------------------------------------------------------- /src/colley.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | using namespace Rcpp; 3 | 4 | 5 | // [[Rcpp::export]] 6 | List eloColley(NumericMatrix teamA, NumericMatrix teamB, NumericVector winsA, NumericVector weightsA, NumericVector weightsB, 7 | NumericVector weights, NumericMatrix k, int nTeams) 8 | { 9 | // this function uses 0-based indexing, since the incoming vectors used -1L 10 | int nGames = winsA.size(); 11 | int ncolA = teamA.ncol(), ncolB = teamB.ncol(); 12 | 13 | NumericMatrix out(nTeams, nTeams); 14 | NumericVector B(nTeams); 15 | NumericVector N(nTeams); 16 | 17 | for(int t = 0; t < nTeams; t++) 18 | { 19 | out(t, t) = 2.0; 20 | B(t) = 1.0; 21 | } 22 | 23 | 24 | for(int g = 0; g < nGames; g++) 25 | { 26 | for(int i = 0; i < ncolA; i++) 27 | { 28 | for(int j = 0; j < ncolB; j++) 29 | { 30 | int a = teamA(g, i), b = teamB(g, j); 31 | double w = weights[g]*weightsA[i]*weightsB[j]; 32 | double iWon = (winsA[g] - 0.5); 33 | 34 | out(b, a) -= w; 35 | out(a, b) -= w; 36 | 37 | out(a, a) += w; 38 | out(b, b) += w; 39 | 40 | B[a] += w*iWon*k(g, 0); 41 | B[b] -= w*iWon*k(g, 1); 42 | 43 | N[a] += w; 44 | N[b] += w; 45 | } 46 | } 47 | } 48 | 49 | return List::create(out, B, N); 50 | } 51 | 52 | -------------------------------------------------------------------------------- /tests/testthat/helper-data.R: -------------------------------------------------------------------------------- 1 | 2 | dat <- data.frame( 3 | team.A = c("Team A", "Team A", "Team C"), 4 | team.B = c("Team B", "Team C", "Team B"), 5 | wins.A = c(1, 1, 0), 6 | dummy.A = 1500, 7 | dummy.B = 1500, 8 | k.column = 20, 9 | home.field = 10, 10 | season = c(1, 2, 2), 11 | week = c(1, 1, 2), 12 | p1.A = c("Player 1", "Player 2", "Player 3"), 13 | p2.A = c("Player 2", "Player 3", "Player 1"), 14 | p1.B = c("Player 4", "Player 4", "Player 4"), 15 | p2.B = c("Player 5", "Player 5", "Player 6") 16 | ) 17 | 18 | init <- c("Team A" = 1600, "Team B" = 1500, "Team C" = 1400) 19 | init.ply <- c("Player 1" = 750, "Player 2" = 750, "Player 3" = 750, 20 | "Player 4" = 600, "Player 5" = 900, "Player 6" = 750) 21 | init.ply2 <- c("Player 1" = 750, "Player 2" = 700, "Player 3" = 650, 22 | "Player 4" = 600, "Player 5" = 900, "Player 6" = 750) 23 | rnd.mat <- function(x, i) round(as.matrix(x)[i, ], 3) 24 | rnd.fin <- function(x, ...) round(final.elos(x, ...), 3) 25 | expect_eq <- function(x, y, z, w = NULL) 26 | { 27 | expect_equal(x, y) 28 | expect_equal(x, z) 29 | if(!is.null(w)) expect_equal(x, w) 30 | } 31 | 32 | elo.run2 <- function(...) 33 | { 34 | Call <- match.call() 35 | Call[[1]] <- quote(elo::elo.run) 36 | Call$update.fun <- quote(elo::elo.update) 37 | Call$prob.fun <- quote(elo::elo.prob) 38 | eval(Call, parent.frame()) 39 | } 40 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # The `elo` Package 2 | 3 | [![CRAN_Status_Badge](http://www.r-pkg.org/badges/version/elo)](https://cran.r-project.org/package=elo) 4 | [![Total Downloads](http://cranlogs.r-pkg.org/badges/grand-total/elo)](https://cran.r-project.org/package=elo) 5 | [![Downloads](http://cranlogs.r-pkg.org/badges/elo)](https://cran.r-project.org/package=elo) 6 | 7 | The `elo` package includes functions to address all kinds of Elo calculations. 8 | 9 | - `elo.prob()`: calculate probabilities based on Elo scores 10 | 11 | - `elo.update()`: calculate Elo updates 12 | 13 | - `elo.calc()`: calculate post-update Elo values 14 | 15 | - `elo.run()` and `elo.run.multiteam()`: calculate "running" Elo values for a series of matches 16 | 17 | It also includes comparable models for accuracy (auc, MSE) benchmarking: 18 | 19 | - `elo.glm()` which fits a logistic regression model 20 | 21 | - `elo.markovchain()` which fits a Markov chain model 22 | 23 | - `elo.colley()` for a method based on the Colley matrix. 24 | 25 | - `elo.winpct()` which fits a model based on win percentage 26 | 27 | Please see the vignettes for examples. 28 | 29 | # Naming Schema 30 | 31 | Most functions begin with the prefix "elo.", for easy autocompletion. 32 | 33 | - Vectors or scalars of Elo scores are denoted "elo.A" or "elo.B". 34 | 35 | - Vectors or scalars of wins by team A are denoted by "wins.A". 36 | 37 | - Vectors or scalars of win probabilities are denoted by "p.A". 38 | 39 | - Vectors of team names are denoted "team.A" or "team.B". 40 | -------------------------------------------------------------------------------- /src/markovChain.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | using namespace Rcpp; 3 | 4 | 5 | // [[Rcpp::export]] 6 | List eloMarkovChain(NumericMatrix teamA, NumericMatrix teamB, NumericVector winsA, NumericVector weightsA, NumericVector weightsB, 7 | NumericVector weights, NumericMatrix k, int nTeams) 8 | { 9 | // this function uses 0-based indexing, since the incoming vectors used -1L 10 | int nGames = winsA.size(); 11 | int ncolA = teamA.ncol(), ncolB = teamB.ncol(); 12 | 13 | NumericMatrix out(nTeams, nTeams); 14 | NumericVector N_i(nTeams); 15 | 16 | for(int g = 0; g < nGames; g++) 17 | { 18 | for(int i = 0; i < ncolA; i++) 19 | { 20 | for(int j = 0; j < ncolB; j++) 21 | { 22 | int a = teamA(g, i), b = teamB(g, j); 23 | double w = weights[g]*weightsA[i]*weightsB[j]; 24 | N_i[a] += w; 25 | N_i[b] += w; 26 | double iWon = winsA[g]; 27 | // (to, from) 28 | out(b, a) += w*(k(g, 0)*(1.0 - iWon) + (1.0 - k(g, 0))*iWon); // if j won, go to j with prob=k; else if i won, go with prob=(1-k) 29 | out(a, b) += w*(k(g, 1)*iWon + (1.0 - k(g, 1))*(1.0 - iWon)); 30 | 31 | out(a, a) += w*(k(g, 0)*iWon + (1.0 - k(g, 0))*(1.0 - iWon)); 32 | out(b, b) += w*(k(g, 1)*(1.0 - iWon) + (1.0 - k(g, 1))*iWon); 33 | } 34 | } 35 | } 36 | 37 | for(int j = 0; j < nTeams; j++) 38 | { 39 | if(N_i[j] > 0.0) 40 | { 41 | out(_, j) = out(_, j) / N_i[j]; 42 | } 43 | } 44 | 45 | return List::create(out, N_i); 46 | } 47 | 48 | -------------------------------------------------------------------------------- /man/elo.mse.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/mse.R 3 | \name{elo.mse} 4 | \alias{elo.mse} 5 | \alias{mse} 6 | \alias{brier} 7 | \alias{mse.elo.run} 8 | \alias{mse.elo.glm} 9 | \alias{mse.elo.running} 10 | \alias{mse.elo.markovchain} 11 | \alias{mse.elo.winpct} 12 | \alias{mse.elo.colley} 13 | \title{Calculate the mean square error} 14 | \usage{ 15 | mse(object, ..., subset = TRUE) 16 | 17 | brier(object, ..., subset = TRUE) 18 | 19 | \method{mse}{elo.run}(object, ..., subset = TRUE) 20 | 21 | \method{mse}{elo.glm}(object, ..., subset = TRUE) 22 | 23 | \method{mse}{elo.running}(object, running = TRUE, discard.skipped = FALSE, ..., subset = TRUE) 24 | 25 | \method{mse}{elo.markovchain}(object, ..., subset = TRUE) 26 | 27 | \method{mse}{elo.winpct}(object, ..., subset = TRUE) 28 | 29 | \method{mse}{elo.colley}(object, ..., subset = TRUE) 30 | } 31 | \arguments{ 32 | \item{object}{An object} 33 | 34 | \item{...}{Other arguments (not used at this time).} 35 | 36 | \item{subset}{(optional) A vector of indices on which to calculate} 37 | 38 | \item{running}{logical, denoting whether to use the running predicted values.} 39 | 40 | \item{discard.skipped}{Logical, denoting whether to ignore the skipped observations in the calculation} 41 | } 42 | \description{ 43 | Calculate the mean square error (Brier score) for a model. 44 | } 45 | \details{ 46 | Even though logistic regressions don't use the MSE on the y=0/1 scale, it can still be informative. 47 | Note that the S3 method is \code{mse}. 48 | } 49 | -------------------------------------------------------------------------------- /R/RcppExports.R: -------------------------------------------------------------------------------- 1 | # Generated by using Rcpp::compileAttributes() -> do not edit by hand 2 | # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 3 | 4 | eloRunAsMatrix <- function(mat, initialElos, group) { 5 | .Call('_elo_eloRunAsMatrix', PACKAGE = 'elo', mat, initialElos, group) 6 | } 7 | 8 | eloRunRegressedAsMatrix <- function(mat, initialElos, regMat, regress, group) { 9 | .Call('_elo_eloRunRegressedAsMatrix', PACKAGE = 'elo', mat, initialElos, regMat, regress, group) 10 | } 11 | 12 | eloColley <- function(teamA, teamB, winsA, weightsA, weightsB, weights, k, nTeams) { 13 | .Call('_elo_eloColley', PACKAGE = 'elo', teamA, teamB, winsA, weightsA, weightsB, weights, k, nTeams) 14 | } 15 | 16 | eloRun <- function(teamA, teamB, weightsA, weightsB, winsA, k, adjTeamA, adjTeamB, regress, to, by, regressUnused, group, initialElos, flag) { 17 | .Call('_elo_eloRun', PACKAGE = 'elo', teamA, teamB, weightsA, weightsB, winsA, k, adjTeamA, adjTeamB, regress, to, by, regressUnused, group, initialElos, flag) 18 | } 19 | 20 | finalElos <- function(mat, nTeams) { 21 | .Call('_elo_finalElos', PACKAGE = 'elo', mat, nTeams) 22 | } 23 | 24 | eloMarkovChain <- function(teamA, teamB, winsA, weightsA, weightsB, weights, k, nTeams) { 25 | .Call('_elo_eloMarkovChain', PACKAGE = 'elo', teamA, teamB, winsA, weightsA, weightsB, weights, k, nTeams) 26 | } 27 | 28 | eloWinPct <- function(winsA, teamA, teamB, weightsA, weightsB, weights, nTeams) { 29 | .Call('_elo_eloWinPct', PACKAGE = 'elo', winsA, teamA, teamB, weightsA, weightsB, weights, nTeams) 30 | } 31 | 32 | -------------------------------------------------------------------------------- /R/elo.R: -------------------------------------------------------------------------------- 1 | #' The Elo Package 2 | #' 3 | #' An implementation of Elo ratings for general use in 'R'. 4 | #' 5 | #' @section Functions: 6 | #' 7 | #' Listed below are the most useful functions available in \code{elo}: 8 | #' 9 | #' \code{\link{elo.prob}}: Calculate the probability that team A beats team B. 10 | #' 11 | #' \code{\link{elo.update}}: Calculate the update value for a given Elo matchup. 12 | #' 13 | #' \code{\link{elo.calc}}: Calculate post-update Elo values. 14 | #' 15 | #' \code{\link{elo.run}}: Calculate Elos for a series of matches. 16 | #' 17 | #' \code{\link{score}}: Create a 1/0/0.5 win "indicator" based on two teams' scores. 18 | #' 19 | #' @section Data: 20 | #' 21 | #' \code{\link{tournament}}: Mock data for examples. 22 | #' 23 | #' @examples 24 | #' library(elo) 25 | #' @references Elo, A. E. 1978. The Rating of Chess Players, Past and Present. New York: Arco. 26 | #' 27 | #' @importFrom stats predict fitted residuals weights 28 | #' @importFrom pROC auc 29 | #' @docType package 30 | #' @aliases elo-package 31 | #' @name elo 32 | #' 33 | NULL 34 | 35 | #' @useDynLib elo 36 | #' @importFrom Rcpp sourceCpp 37 | NULL 38 | 39 | #### commands to build the package using devtools 40 | # devtools::check_man() 41 | # devtools::test() 42 | # devtools::check() 43 | # devtools::install(build_vignettes = TRUE, dependencies = FALSE)) 44 | # devtools::build("../elo/") 45 | ## < restart R > 46 | ## library(elo") 47 | 48 | #### to upload to CRAN 49 | ## Update DESCRIPTION, README.md, NEWS.md, and cran-comments.md 50 | # devtools::revdep_check() 51 | # devtools::release() 52 | -------------------------------------------------------------------------------- /man/auc.elo.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/auc.R 3 | \name{auc.elo} 4 | \alias{auc.elo} 5 | \alias{auc.elo.run} 6 | \alias{auc.elo.glm} 7 | \alias{auc.elo.running} 8 | \alias{auc.elo.markovchain} 9 | \alias{auc.elo.winpct} 10 | \alias{auc.elo.colley} 11 | \title{Calculate AUC on an \code{elo.run} object} 12 | \usage{ 13 | \method{auc}{elo.run}(object, ..., subset = TRUE) 14 | 15 | \method{auc}{elo.glm}(object, ..., subset = TRUE) 16 | 17 | \method{auc}{elo.running}(object, running = TRUE, discard.skipped = FALSE, ..., subset = TRUE) 18 | 19 | \method{auc}{elo.markovchain}(object, ..., subset = TRUE) 20 | 21 | \method{auc}{elo.winpct}(object, ..., subset = TRUE) 22 | 23 | \method{auc}{elo.colley}(object, ..., subset = TRUE) 24 | } 25 | \arguments{ 26 | \item{object}{An object of class \code{\link{elo.run}}.} 27 | 28 | \item{...}{Other arguments (not used at this time).} 29 | 30 | \item{subset}{(optional) A vector of indices on which to calculate} 31 | 32 | \item{running}{logical, denoting whether to use the running predicted values.} 33 | 34 | \item{discard.skipped}{Logical, denoting whether to ignore the skipped observations in the calculation} 35 | } 36 | \value{ 37 | The AUC of the predicted Elo probabilities and the actual win results. 38 | } 39 | \description{ 40 | Calculate AUC on an \code{elo.run} object 41 | } 42 | \references{ 43 | Adapted from code here: 44 | \url{https://stat.ethz.ch/pipermail/r-help/2005-September/079872.html} 45 | } 46 | \seealso{ 47 | \code{pROC::\link[pROC]{auc}}, \code{\link{elo.run}}. 48 | } 49 | -------------------------------------------------------------------------------- /man/favored.elo.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/favored.R 3 | \name{favored.elo} 4 | \alias{favored.elo} 5 | \alias{favored} 6 | \alias{favored.elo.run} 7 | \alias{favored.elo.glm} 8 | \alias{favored.elo.running} 9 | \alias{favored.elo.markovchain} 10 | \alias{favored.elo.winpct} 11 | \alias{favored.elo.colley} 12 | \alias{favored.default} 13 | \title{Classify teams that are favored to win} 14 | \usage{ 15 | favored(x, ..., subset = TRUE) 16 | 17 | \method{favored}{elo.run}(x, ..., subset = TRUE) 18 | 19 | \method{favored}{elo.glm}(x, ..., subset = TRUE) 20 | 21 | \method{favored}{elo.running}(x, running = TRUE, discard.skipped = FALSE, ..., subset = TRUE) 22 | 23 | \method{favored}{elo.markovchain}(x, ..., subset = TRUE) 24 | 25 | \method{favored}{elo.winpct}(x, ..., subset = TRUE) 26 | 27 | \method{favored}{elo.colley}(x, ..., subset = TRUE) 28 | 29 | \method{favored}{default}(x, p.A, ...) 30 | } 31 | \arguments{ 32 | \item{x}{An object from \code{\link{elo.run}} or \code{\link{elo.glm}}, or for the default method 33 | a vector representing wins.A.} 34 | 35 | \item{...}{Other arguments (not used at this time).} 36 | 37 | \item{subset}{(optional) A vector of indices on which to calculate} 38 | 39 | \item{running}{logical, denoting whether to use the running predicted values.} 40 | 41 | \item{discard.skipped}{Logical, denoting whether to ignore the skipped observations in the calculation} 42 | 43 | \item{p.A}{A vector of predicted win probabilities.} 44 | } 45 | \description{ 46 | Classify teams that are favored to win 47 | } 48 | -------------------------------------------------------------------------------- /tests/testthat/test_elo.winpct.R: -------------------------------------------------------------------------------- 1 | context("Testing the elo.winpct function") 2 | 3 | ########################################################################################################### 4 | #### Do some simple checks 5 | ########################################################################################################### 6 | 7 | trn <- tournament 8 | trn$diff <- score(trn$points.Home, trn$points.Visitor) 9 | trn <- trn[trn$diff %in% 0:1, ] 10 | trn$neut <- replace(rep(0, times = nrow(trn)), c(3, 30), 1) 11 | 12 | test_that("elo.winpct is working correctly", { 13 | tmp.wl <- elo.winpct(score(points.Home, points.Visitor) ~ team.Home + team.Visitor, data = trn) 14 | 15 | expect_equal(unname(tmp.wl$win.pct), c(10/13, 4/14, 7/12, 2/13, 7/13, 9/14, 6/10, 6/13)) 16 | expect_equal(sum(tmp.wl$win.pct * tmp.wl$n.games), 51) 17 | expect_equal(tmp.wl$n.games, as.vector(table(c(trn$team.Home, trn$team.Visitor)))) 18 | 19 | tmp.wl.wt <- elo.winpct(score(points.Home, points.Visitor) ~ team.Home + team.Visitor, data = trn, weights = 1:51) 20 | expect_equal(sum(tmp.wl.wt$win.pct * tmp.wl.wt$n.games), sum(1:51)) 21 | expect_equal(tmp.wl.wt$n.games, as.vector(xtabs(c(1:51, 1:51) ~ c(trn$team.Home, trn$team.Visitor)))) 22 | 23 | tmp.wl.players <- elo.winpct(score(points.Home, points.Visitor) ~ players(team.Home, "Zealous Zebras") + players(team.Visitor, "Yelling Yaks"), data = trn) 24 | expect_equal(sum(tmp.wl.players$win.pct * tmp.wl.players$n.games), 51) 25 | expect_equal(tmp.wl.players$n.games, 0.5*as.vector(table(c(trn$team.Home, trn$team.Visitor, rep(c("Zealous Zebras", "Yelling Yaks"), each = 51))))) 26 | }) 27 | -------------------------------------------------------------------------------- /man/elo.model.frame.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/elo.model.frame.R 3 | \name{elo.model.frame} 4 | \alias{elo.model.frame} 5 | \title{Interpret formulas in \code{elo} functions} 6 | \usage{ 7 | elo.model.frame( 8 | formula, 9 | data, 10 | na.action, 11 | subset, 12 | k = NULL, 13 | ..., 14 | required.vars = "elos", 15 | warn.k = TRUE, 16 | ncol.k = 1, 17 | ncol.elos = 2 18 | ) 19 | } 20 | \arguments{ 21 | \item{formula}{A formula. See \link[=formula.specials]{the help page for formulas} for details.} 22 | 23 | \item{data}{A \code{data.frame} in which to look for objects in \code{formula}.} 24 | 25 | \item{na.action}{A function which indicates what should happen when the data contain NAs.} 26 | 27 | \item{subset}{An optional vector specifying a subset of observations.} 28 | 29 | \item{k}{A constant k-value (or a vector, where appropriate).} 30 | 31 | \item{...}{Other arguments (not in use at this time).} 32 | 33 | \item{required.vars}{One or more of \code{c("wins", "elos", "k", "group", "regress")}, 34 | denoting which variables are required to appear in the final model.frame.} 35 | 36 | \item{warn.k}{Should a warning be issued if \code{k} is specified as an argument and in \code{formula}?} 37 | 38 | \item{ncol.k}{How many columns (\code{NCOL}) should \code{k} have?} 39 | 40 | \item{ncol.elos}{How many Elo columns are expected?} 41 | } 42 | \description{ 43 | A helper function to create the \code{model.frame} for many \code{elo} functions. 44 | } 45 | \seealso{ 46 | \code{\link{elo.run}}, \code{\link{elo.calc}}, \code{\link{elo.update}}, \code{\link{elo.prob}} 47 | } 48 | -------------------------------------------------------------------------------- /R/elo.update.R: -------------------------------------------------------------------------------- 1 | 2 | #' Elo updates 3 | #' 4 | #' Calculate the update value for a given Elo matchup. This is used in 5 | #' \code{\link{elo.calc}}, which reports the post-update Elo values. This is vectorized. 6 | #' 7 | #' @inheritParams elo.calc 8 | #' @return A vector of Elo updates. 9 | #' @examples 10 | #' elo.update(c(1, 0), c(1500, 1500), c(1500, 1600), k = 20) 11 | #' 12 | #' dat <- data.frame(wins.A = c(1, 0), elo.A = c(1500, 1500), 13 | #' elo.B = c(1500, 1600), k = c(20, 20)) 14 | #' elo.update(wins.A ~ elo.A + elo.B + k(k), data = dat) 15 | #' @seealso \code{\link{elo.prob}}, \code{\link{elo.calc}}, 16 | #' \code{elo.model.frame} 17 | #' @name elo.update 18 | NULL 19 | #> NULL 20 | 21 | #' @rdname elo.update 22 | #' @export 23 | elo.update <- function(wins.A, ...) 24 | { 25 | UseMethod("elo.update") 26 | } 27 | 28 | #' @rdname elo.update 29 | #' @export 30 | elo.update.default <- function(wins.A, elo.A, elo.B, k, ..., adjust.A = 0, adjust.B = 0) 31 | { 32 | validate_score(wins.A) 33 | remove_elo_k(k)*(wins.A - elo.prob(elo.A, elo.B, ..., adjust.A = adjust.A, adjust.B = adjust.B)) 34 | } 35 | 36 | #' @rdname elo.update 37 | #' @export 38 | elo.update.formula <- function(formula, data, na.action, subset, k = NULL, ...) 39 | { 40 | Call <- match.call() 41 | Call <- Call[c(1, match(c("formula", "data", "subset", "na.action", "k"), names(Call), nomatch = 0))] 42 | Call[[1L]] <- quote(elo::elo.model.frame) 43 | Call$required.vars <- c("wins", "elos", "k") 44 | mf <- eval(Call, parent.frame()) 45 | elo.update(mf$wins.A, mf$elo.A, mf$elo.B, k = mf$k, ..., 46 | adjust.A = mf$adj.A, adjust.B = mf$adj.B) 47 | } 48 | 49 | -------------------------------------------------------------------------------- /man/summary.elo.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/summary.R 3 | \name{summary.elo} 4 | \alias{summary.elo} 5 | \alias{summary.elo.run} 6 | \alias{summary.elo.glm} 7 | \alias{summary.elo.markovchain} 8 | \alias{summary.elo.colley} 9 | \alias{summary.elo.winpct} 10 | \title{Summarize an \code{elo} Object} 11 | \usage{ 12 | \method{summary}{elo.run}(object, ...) 13 | 14 | \method{summary}{elo.glm}(object, ...) 15 | 16 | \method{summary}{elo.markovchain}(object, ...) 17 | 18 | \method{summary}{elo.colley}(object, ...) 19 | 20 | \method{summary}{elo.winpct}(object, ...) 21 | } 22 | \arguments{ 23 | \item{object}{An object to summarize.} 24 | 25 | \item{...}{Other arguments} 26 | } 27 | \value{ 28 | A summary of \code{object}. 29 | } 30 | \description{ 31 | Summarize an \code{elo} Object 32 | } 33 | \examples{ 34 | summary(elo.run(score(points.Home, points.Visitor) ~ team.Home + team.Visitor, 35 | data = tournament, k = 20)) 36 | summary(elo.glm(score(points.Home, points.Visitor) ~ team.Home + team.Visitor, 37 | data = tournament)) 38 | mc <- elo.markovchain(score(points.Home, points.Visitor) ~ team.Home + team.Visitor, 39 | data = tournament, subset = points.Home != points.Visitor, k = 0.7) 40 | summary(mc) 41 | co <- elo.colley(score(points.Home, points.Visitor) ~ team.Home + team.Visitor, 42 | data = tournament, subset = points.Home != points.Visitor) 43 | summary(co) 44 | wp <- elo.winpct(score(points.Home, points.Visitor) ~ team.Home + team.Visitor, 45 | data = tournament, subset = points.Home != points.Visitor, k = 0.7) 46 | summary(wp) 47 | } 48 | \seealso{ 49 | \code{\link{favored}}, \code{\link{auc.elo.run}}, \code{\link{mse}} 50 | } 51 | -------------------------------------------------------------------------------- /tests/testthat/test_elo.run.multiteam.R: -------------------------------------------------------------------------------- 1 | context("Testing the elo.run.multiteam function") 2 | 3 | test_that("Basic Elo calculations work", { 4 | expect_eq( 5 | rnd.mat(elo.run.multiteam(~ multiteam("Team A", "Team B", "Team C"), k = 20)), 6 | rnd.mat(elo.run.multiteam(~ multiteam("Team A", "Team B", "Team C") + group(1), k = 20)), 7 | rnd.mat(elo.run(wins.A ~ team.A + team.B + group(rep(1, 3)), k = 20, data = dat)), 8 | c("Team A" = 1520, "Team B" = 1500, "Team C" = 1480) 9 | ) 10 | expect_eq( 11 | rnd.mat(elo.run.multiteam(~ multiteam("Team A", "Team B"), data = dat, k = 20)), 12 | rnd.mat(elo.run(wins.A ~ team.A + team.B, k = 20, data = dat, subset = 1)), 13 | c("Team A" = 1510, "Team B" = 1490) 14 | ) 15 | 16 | expect_eq( 17 | rnd.mat(elo.run.multiteam(~ multiteam(c("Team A", "Team A"), c("Team B", "Team B"), c("Team C", NA)), k = 20), 2), 18 | rnd.mat(elo.run(wins.A ~ team.A + team.B + group(c(rep(1, 3), 2)), k = 20, data = dat[c(1:3, 1), ]), 2), 19 | c("Team A" = 1529.425, "Team B" = 1490.575, "Team C" = 1480) 20 | ) 21 | }) 22 | 23 | test_that("prediction works correctly", { 24 | erm <- elo.run.multiteam(~ multiteam(Place_1, Place_2, Place_3, Place_4), data = tournament.multiteam, subset = -(27:28), k = 20) 25 | newdat <- tournament.multiteam[27:28, ] 26 | expect_equal( 27 | rowSums(predict(erm, newdata = newdat)), 28 | c(1, 1) 29 | ) 30 | expect_equal( 31 | predict(erm, newdata = newdat), 32 | matrix(c( 33 | 10^(final.elos(erm)[1:4]/400) / sum(10^(final.elos(erm)[1:4]/400)), 34 | 10^(final.elos(erm)[c(7:6, 8, 5)]/400) / sum(10^(final.elos(erm)[5:8]/400)) 35 | ), nrow = 2, byrow = TRUE, dimnames = NULL) 36 | ) 37 | }) 38 | -------------------------------------------------------------------------------- /man/elo.calc.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/elo.calc.R 3 | \name{elo.calc} 4 | \alias{elo.calc} 5 | \alias{elo.calc.default} 6 | \alias{elo.calc.formula} 7 | \title{Post-update Elo values} 8 | \usage{ 9 | elo.calc(wins.A, ...) 10 | 11 | \method{elo.calc}{default}(wins.A, elo.A, elo.B, k, ..., adjust.A = 0, adjust.B = 0) 12 | 13 | \method{elo.calc}{formula}(formula, data, na.action, subset, k = NULL, ...) 14 | } 15 | \arguments{ 16 | \item{wins.A}{Numeric vector of wins by team A.} 17 | 18 | \item{...}{Other arguments (not in use at this time).} 19 | 20 | \item{elo.A, elo.B}{Numeric vectors of elo scores.} 21 | 22 | \item{k}{A constant k-value (or a vector, where appropriate).} 23 | 24 | \item{adjust.A, adjust.B}{Numeric vectors to adjust \code{elo.A} and \code{elo.B} by.} 25 | 26 | \item{formula}{A formula. See \link[=formula.specials]{the help page for formulas} for details.} 27 | 28 | \item{data}{A \code{data.frame} in which to look for objects in \code{formula}.} 29 | 30 | \item{na.action}{A function which indicates what should happen when the data contain NAs.} 31 | 32 | \item{subset}{An optional vector specifying a subset of observations.} 33 | } 34 | \value{ 35 | A data.frame with two columns, giving the new Elo values after each update. 36 | } 37 | \description{ 38 | Calculate post-update Elo values. This is vectorized. 39 | } 40 | \examples{ 41 | elo.calc(c(1, 0), c(1500, 1500), c(1500, 1600), k = 20) 42 | 43 | dat <- data.frame(wins.A = c(1, 0), elo.A = c(1500, 1500), 44 | elo.B = c(1500, 1600), k = c(20, 20)) 45 | elo.calc(wins.A ~ elo.A + elo.B + k(k), data = dat) 46 | } 47 | \seealso{ 48 | \code{\link{elo.prob}}, \code{\link{elo.update}}, 49 | \code{elo.model.frame} 50 | } 51 | -------------------------------------------------------------------------------- /R/fitted.R: -------------------------------------------------------------------------------- 1 | 2 | #' Extract model values 3 | #' 4 | #' Extract model values from \code{elo} functions. 5 | #' 6 | #' @param object An object. 7 | #' @param ... Other arguments 8 | #' @param running logical, denoting whether to use the running predicted values. 9 | #' @return A vector of fitted values. For running values, it has an additional attribute denoting to which 10 | #' group (i.e., which model) the prediction belongs 11 | #' @name fitted.elo 12 | NULL 13 | #> NULL 14 | 15 | ## stats:::terms.default and stats:::weights.default also work 16 | 17 | #' @rdname fitted.elo 18 | #' @export 19 | fitted.elo.run <- function(object, ...) 20 | { 21 | out <- object$elos[, sum(object$n.players) + 1] 22 | stats::napredict(object$na.action, out) 23 | } 24 | 25 | #' @rdname fitted.elo 26 | #' @export 27 | residuals.elo.run <- function(object, ...) 28 | { 29 | out <- object$elos[, sum(object$n.players) + 2] - object$elos[, sum(object$n.players) + 1] 30 | stats::naresid(object$na.action, out) 31 | } 32 | 33 | #' @rdname fitted.elo 34 | #' @export 35 | fitted.elo.running <- function(object, running = TRUE, ...) 36 | { 37 | if(!running) return(NextMethod()) 38 | a <- stats::napredict(object$na.action, attr(object$running.values, "group")) 39 | out <- stats::napredict(object$na.action, object$running.values) 40 | attr(out, "group") <- a 41 | out 42 | } 43 | 44 | #' @rdname fitted.elo 45 | #' @export 46 | fitted.elo.glm <- function(object, ...) 47 | { 48 | stats::napredict(object$na.action, object$fitted.values) 49 | } 50 | 51 | #' @rdname fitted.elo 52 | #' @export 53 | fitted.elo.markovchain <- fitted.elo.glm 54 | 55 | #' @rdname fitted.elo 56 | #' @export 57 | fitted.elo.winpct <- fitted.elo.glm 58 | 59 | #' @rdname fitted.elo 60 | #' @export 61 | fitted.elo.colley <- fitted.elo.glm 62 | -------------------------------------------------------------------------------- /man/elo.update.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/elo.update.R 3 | \name{elo.update} 4 | \alias{elo.update} 5 | \alias{elo.update.default} 6 | \alias{elo.update.formula} 7 | \title{Elo updates} 8 | \usage{ 9 | elo.update(wins.A, ...) 10 | 11 | \method{elo.update}{default}(wins.A, elo.A, elo.B, k, ..., adjust.A = 0, adjust.B = 0) 12 | 13 | \method{elo.update}{formula}(formula, data, na.action, subset, k = NULL, ...) 14 | } 15 | \arguments{ 16 | \item{wins.A}{Numeric vector of wins by team A.} 17 | 18 | \item{...}{Other arguments (not in use at this time).} 19 | 20 | \item{elo.A, elo.B}{Numeric vectors of elo scores.} 21 | 22 | \item{k}{A constant k-value (or a vector, where appropriate).} 23 | 24 | \item{adjust.A, adjust.B}{Numeric vectors to adjust \code{elo.A} and \code{elo.B} by.} 25 | 26 | \item{formula}{A formula. See \link[=formula.specials]{the help page for formulas} for details.} 27 | 28 | \item{data}{A \code{data.frame} in which to look for objects in \code{formula}.} 29 | 30 | \item{na.action}{A function which indicates what should happen when the data contain NAs.} 31 | 32 | \item{subset}{An optional vector specifying a subset of observations.} 33 | } 34 | \value{ 35 | A vector of Elo updates. 36 | } 37 | \description{ 38 | Calculate the update value for a given Elo matchup. This is used in 39 | \code{\link{elo.calc}}, which reports the post-update Elo values. This is vectorized. 40 | } 41 | \examples{ 42 | elo.update(c(1, 0), c(1500, 1500), c(1500, 1600), k = 20) 43 | 44 | dat <- data.frame(wins.A = c(1, 0), elo.A = c(1500, 1500), 45 | elo.B = c(1500, 1600), k = c(20, 20)) 46 | elo.update(wins.A ~ elo.A + elo.B + k(k), data = dat) 47 | } 48 | \seealso{ 49 | \code{\link{elo.prob}}, \code{\link{elo.calc}}, 50 | \code{elo.model.frame} 51 | } 52 | -------------------------------------------------------------------------------- /R/rank.teams.R: -------------------------------------------------------------------------------- 1 | 2 | #' Rank teams 3 | #' 4 | #' Extract the rankings from Elo objects. 5 | #' 6 | #' @param object An object. 7 | #' @param ties.method Passed to \code{\link{rank}}. 8 | #' @param regressed Passed to \code{\link{final.elos}}. 9 | #' @param ... Other arguments 10 | #' @name rank.teams 11 | NULL 12 | #> NULL 13 | 14 | #' @rdname rank.teams 15 | #' @export 16 | rank.teams <- function(object, ties.method = "min", ...) 17 | { 18 | UseMethod("rank.teams") 19 | } 20 | 21 | #' @rdname rank.teams 22 | #' @export 23 | rank.teams.elo.run <- function(object, ties.method = "min", ...) 24 | { 25 | rank(-final.elos(object), ties.method = ties.method) 26 | } 27 | 28 | #' @rdname rank.teams 29 | #' @export 30 | rank.teams.elo.run.regressed <- function(object, ties.method = "min", regressed = FALSE, ...) 31 | { 32 | rank(-final.elos(object, regressed = regressed), ties.method = ties.method) 33 | } 34 | 35 | #' @rdname rank.teams 36 | #' @export 37 | rank.teams.elo.glm <- function(object, ties.method = "min", ...) 38 | { 39 | coeff <- stats::setNames(object$coefficients, setdiff(names(object$data), "wins.A")) 40 | others <- setdiff(object$teams, names(coeff)) 41 | others <- stats::setNames(rep(0, length(others)), others) 42 | rank(-c(coeff, others)[object$teams], ties.method = ties.method) 43 | } 44 | 45 | #' @rdname rank.teams 46 | #' @export 47 | rank.teams.elo.markovchain <- function(object, ties.method = "min", ...) 48 | { 49 | rank(-object$pi, ties.method = ties.method) 50 | } 51 | 52 | #' @rdname rank.teams 53 | #' @export 54 | rank.teams.elo.winpct <- function(object, ties.method = "min", ...) 55 | { 56 | rank(-object$win.pct, ties.method = ties.method) 57 | } 58 | 59 | #' @rdname rank.teams 60 | #' @export 61 | rank.teams.elo.colley <- function(object, ties.method = "min", ...) 62 | { 63 | rank(-object$pi, ties.method = ties.method) 64 | } 65 | 66 | 67 | 68 | 69 | -------------------------------------------------------------------------------- /data-raw/tournament.R: -------------------------------------------------------------------------------- 1 | set.seed(88) 2 | 3 | all.teams <- c("Athletic Armadillos", "Blundering Baboons", "Cunning Cats", "Defense-less Dogs", "Elegant Emus", 4 | "Fabulous Frogs", "Gallivanting Gorillas", "Helpless Hyenas") 5 | means <- c(18, 12, 17, 13, 16, 15.5, 14, 14.5) 6 | names(means) <- all.teams 7 | 8 | tournament <- expand.grid(team.Home = all.teams, team.Visitor = all.teams, stringsAsFactors = FALSE) 9 | tournament <- tournament[tournament$team.Home != tournament$team.Visitor, ] 10 | 11 | tournament$points.Home <- vapply(means[tournament$team.Home] + 3, stats::rpois, 0, n = 1) 12 | tournament$points.Visitor <- vapply(means[tournament$team.Visitor], stats::rpois, 0, n = 1) 13 | 14 | tournament$week <- 0 15 | tournament$week[1] <- 1 16 | for(i in 2:nrow(tournament)) 17 | { 18 | t1 <- tournament$team.Home[i] 19 | t2 <- tournament$team.Visitor[i] 20 | idx <- 1:(i-1) 21 | wks <- tournament$week[idx] 22 | tm1 <- tournament$team.Home[idx] 23 | tm2 <- tournament$team.Visitor[idx] 24 | 25 | tournament$week[i] <- min(setdiff(1:14, wks[tm1 %in% c(t1, t2) | tm2 %in% c(t1, t2)])) 26 | } 27 | 28 | tournament$half <- ifelse(tournament$week < 8, "First Half of Season", "Second Half of Season") 29 | tournament <- tournament[order(tournament$week), ] 30 | rownames(tournament) <- NULL 31 | attr(tournament, "out.attrs") <- NULL 32 | 33 | usethis::use_data(tournament) 34 | 35 | 36 | 37 | library(tidyverse) 38 | tournament.multiteam <- tournament %>% 39 | pivot_longer(c(-week, -half), names_pattern = "(.*)\\.(.*)", names_to = c(".value", "home.vis")) %>% 40 | arrange(week, home.vis, desc(points), team) %>% 41 | group_by(week, home.vis) %>% 42 | mutate(place = paste0("Place_", 1:n())) %>% 43 | ungroup() %>% 44 | select(-points) %>% 45 | pivot_wider(names_from = place, values_from = team) %>% 46 | select(-home.vis) 47 | usethis::use_data(tournament.multiteam) 48 | -------------------------------------------------------------------------------- /R/mse.R: -------------------------------------------------------------------------------- 1 | #' Calculate the mean square error 2 | #' 3 | #' Calculate the mean square error (Brier score) for a model. 4 | #' @param object An object 5 | #' @param subset (optional) A vector of indices on which to calculate 6 | #' @param running logical, denoting whether to use the running predicted values. 7 | #' @param discard.skipped Logical, denoting whether to ignore the skipped observations in the calculation 8 | #' @param ... Other arguments (not used at this time). 9 | #' @details Even though logistic regressions don't use the MSE on the y=0/1 scale, it can still be informative. 10 | #' Note that the S3 method is \code{mse}. 11 | #' @name elo.mse 12 | NULL 13 | #> NULL 14 | 15 | #' @rdname elo.mse 16 | #' @export 17 | mse <- function(object, ..., subset = TRUE) 18 | { 19 | UseMethod("mse") 20 | } 21 | 22 | #' @rdname elo.mse 23 | #' @export 24 | brier <- mse 25 | 26 | #' @rdname elo.mse 27 | #' @export 28 | mse.elo.run <- function(object, ..., subset = TRUE) 29 | { 30 | r <- residuals(object) 31 | mean(r[subset]^2) 32 | } 33 | 34 | #' @rdname elo.mse 35 | #' @export 36 | mse.elo.glm <- function(object, ..., subset = TRUE) 37 | { 38 | r <- object$fitted.values - object$y 39 | mean(r[subset]^2) 40 | } 41 | 42 | #' @rdname elo.mse 43 | #' @export 44 | mse.elo.running <- function(object, running = TRUE, discard.skipped = FALSE, ..., subset = TRUE) 45 | { 46 | if(!running) return(NextMethod()) 47 | if(!is.logical(subset)) stop("'subset' must be logical for this functionality") 48 | idx <- attr(object$running.values, "group") > (if(discard.skipped) 0 else -1) 49 | r <- object$running.values - object$y 50 | mean(r[idx & subset]^2) 51 | } 52 | 53 | #' @rdname elo.mse 54 | #' @export 55 | mse.elo.markovchain <- mse.elo.glm 56 | 57 | #' @rdname elo.mse 58 | #' @export 59 | mse.elo.winpct <- mse.elo.glm 60 | 61 | #' @rdname elo.mse 62 | #' @export 63 | mse.elo.colley <- mse.elo.glm 64 | -------------------------------------------------------------------------------- /R/auc.R: -------------------------------------------------------------------------------- 1 | 2 | #' Calculate AUC on an \code{elo.run} object 3 | #' 4 | #' @param object An object of class \code{\link{elo.run}}. 5 | #' @inheritParams mse 6 | #' @references Adapted from code here: 7 | #' \url{https://stat.ethz.ch/pipermail/r-help/2005-September/079872.html} 8 | #' @return The AUC of the predicted Elo probabilities and the actual win results. 9 | #' @seealso \code{pROC::\link[pROC]{auc}}, \code{\link{elo.run}}. 10 | #' @name auc.elo 11 | NULL 12 | #> NULL 13 | 14 | get_auc <- function(wins, probs) 15 | { 16 | x.won <- probs[wins == 1] 17 | x.lost <- probs[wins == 0] 18 | 19 | n.won <- 0 + length(x.won) # to coerce to double 20 | if(n.won == 0 || length(x.lost) == 0) stop("Unable to calculate AUC: need both 0 and 1 in the wins column.") 21 | (sum(rank(c(x.won, x.lost))[1:n.won]) - n.won*(n.won + 1)/2)/(n.won * length(x.lost)) 22 | } 23 | 24 | #' @rdname auc.elo 25 | #' @export 26 | auc.elo.run <- function(object, ..., subset = TRUE) 27 | { 28 | probs <- fitted(object) 29 | wins <- object$elos[, sum(object$n.players) + 2] 30 | get_auc(wins[subset], probs[subset]) 31 | } 32 | 33 | #' @rdname auc.elo 34 | #' @export 35 | auc.elo.glm <- function(object, ..., subset = TRUE) 36 | { 37 | get_auc(object$y[subset], object$fitted.values[subset]) 38 | } 39 | 40 | #' @rdname auc.elo 41 | #' @export 42 | auc.elo.running <- function(object, running = TRUE, discard.skipped = FALSE, ..., subset = TRUE) 43 | { 44 | if(!running) return(NextMethod()) 45 | if(!is.logical(subset)) stop("'subset' must be logical for this functionality") 46 | idx <- attr(object$running.values, "group") > (if(discard.skipped) 0 else -1) 47 | get_auc(object$y[idx & subset], object$running.values[idx & subset]) 48 | } 49 | 50 | #' @rdname auc.elo 51 | #' @export 52 | auc.elo.markovchain <- auc.elo.glm 53 | 54 | #' @rdname auc.elo 55 | #' @export 56 | auc.elo.winpct <- auc.elo.glm 57 | 58 | #' @rdname auc.elo 59 | #' @export 60 | auc.elo.colley <- auc.elo.glm 61 | -------------------------------------------------------------------------------- /man/elo.run.helpers.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/elo.run.helpers.R 3 | \name{elo.run.helpers} 4 | \alias{elo.run.helpers} 5 | \alias{as.matrix.elo.run} 6 | \alias{as.matrix.elo.run.regressed} 7 | \alias{as.data.frame.elo.run} 8 | \alias{final.elos} 9 | \alias{final.elos.elo.run} 10 | \alias{final.elos.elo.run.regressed} 11 | \title{Helper functions for \code{elo.run}} 12 | \usage{ 13 | \method{as.matrix}{elo.run}(x, ...) 14 | 15 | \method{as.matrix}{elo.run.regressed}(x, ...) 16 | 17 | \method{as.data.frame}{elo.run}(x, ...) 18 | 19 | final.elos(x, ...) 20 | 21 | \method{final.elos}{elo.run}(x, ...) 22 | 23 | \method{final.elos}{elo.run.regressed}(x, regressed = FALSE, ...) 24 | } 25 | \arguments{ 26 | \item{x}{An object of class \code{"elo.run"} or class \code{"elo.run.regressed"}.} 27 | 28 | \item{...}{Other arguments (Not in use at this time).} 29 | 30 | \item{regressed}{Logical, denoting whether to use the post-regressed (\code{TRUE}) or 31 | pre-regressed (\code{FALSE}) final Elos. Note that \code{TRUE} only makes sense when the 32 | final Elos were regressed one last time (i.e., if the last element of the \code{regress()}) 33 | vector yields \code{TRUE}).} 34 | } 35 | \value{ 36 | A matrix, a data.frame, or a named vector. 37 | } 38 | \description{ 39 | \code{as.matrix} converts an Elo object into a matrix of running Elos. These are the Elos at the time of grouping, 40 | but before any regression takes place. 41 | } 42 | \details{ 43 | \code{as.data.frame} converts the \code{"elos"} component of an object 44 | from \code{\link{elo.run}} into a data.frame. 45 | 46 | \code{final.elos} is a generic function to extract the last Elo per team. 47 | } 48 | \examples{ 49 | e <- elo.run(score(points.Home, points.Visitor) ~ team.Home + team.Visitor + group(week), 50 | data = tournament, k = 20) 51 | head(as.matrix(e)) 52 | str(as.data.frame(e)) 53 | final.elos(e) 54 | } 55 | \seealso{ 56 | \code{\link{elo.run}} 57 | } 58 | -------------------------------------------------------------------------------- /src/asMatrix.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | using namespace Rcpp; 3 | 4 | // [[Rcpp::export]] 5 | NumericMatrix eloRunAsMatrix(NumericMatrix mat, NumericVector initialElos, LogicalVector group) 6 | { 7 | // this function uses 1-based indexing, since the incoming matrix does, too 8 | double nTeams = initialElos.size(); 9 | double nGames = mat.nrow(); 10 | double nOut = sum(group); 11 | int nBoth = (mat.ncol() - 4) / 2; 12 | NumericMatrix out(nOut, nTeams); 13 | NumericVector curr(nTeams); 14 | curr = clone(initialElos); 15 | int outRow = 0; 16 | 17 | for(int i = 0; i < nGames; i++) 18 | { 19 | for(int j = 0; j < nBoth; j++) 20 | { 21 | double tm = mat(i, j); 22 | if(tm > 0) 23 | { 24 | curr[tm - 1] = mat(i, nBoth + 4 + j); 25 | } 26 | } 27 | 28 | if(group[i]) 29 | { 30 | out(outRow, _) = curr; 31 | outRow++; 32 | } 33 | } 34 | return out; 35 | } 36 | 37 | // [[Rcpp::export]] 38 | NumericMatrix eloRunRegressedAsMatrix(NumericMatrix mat, NumericVector initialElos, 39 | NumericMatrix regMat, LogicalVector regress, LogicalVector group) 40 | { 41 | // this function uses 1-based indexing, since the incoming matrix does, too 42 | double nTeams = initialElos.size(); 43 | double nGames = mat.nrow(); 44 | double nOut = sum(group); 45 | int nBoth = (mat.ncol() - 4) / 2; 46 | NumericMatrix out(nOut, nTeams); 47 | NumericVector curr(nTeams); 48 | curr = clone(initialElos); 49 | int regRow = 0, outRow = 0; 50 | 51 | for(int i = 0; i < nGames; i++) 52 | { 53 | if(i > 0 && regress[i - 1]) 54 | { 55 | curr = regMat(regRow, _); 56 | regRow++; 57 | } 58 | 59 | for(int j = 0; j < nBoth; j++) 60 | { 61 | double tm = mat(i, j); 62 | if(tm > 0) 63 | { 64 | curr[tm - 1] = mat(i, nBoth + 4 + j); 65 | } 66 | } 67 | 68 | if(group[i]) 69 | { 70 | out(outRow, _) = curr; 71 | outRow++; 72 | } 73 | } 74 | return out; 75 | } 76 | 77 | -------------------------------------------------------------------------------- /R/elo.calc.R: -------------------------------------------------------------------------------- 1 | 2 | #' Post-update Elo values 3 | #' 4 | #' Calculate post-update Elo values. This is vectorized. 5 | #' 6 | #' @inheritParams elo.model.frame 7 | #' @param elo.A,elo.B Numeric vectors of elo scores. 8 | #' @param wins.A Numeric vector of wins by team A. 9 | #' @param ... Other arguments (not in use at this time). 10 | #' @param adjust.A,adjust.B Numeric vectors to adjust \code{elo.A} and \code{elo.B} by. 11 | #' @seealso \code{\link{elo.prob}}, \code{\link{elo.update}}, 12 | #' \code{elo.model.frame} 13 | #' @return A data.frame with two columns, giving the new Elo values after each update. 14 | #' @examples 15 | #' elo.calc(c(1, 0), c(1500, 1500), c(1500, 1600), k = 20) 16 | #' 17 | #' dat <- data.frame(wins.A = c(1, 0), elo.A = c(1500, 1500), 18 | #' elo.B = c(1500, 1600), k = c(20, 20)) 19 | #' elo.calc(wins.A ~ elo.A + elo.B + k(k), data = dat) 20 | #' @name elo.calc 21 | NULL 22 | #> NULL 23 | 24 | #' @rdname elo.calc 25 | #' @export 26 | elo.calc <- function(wins.A, ...) 27 | { 28 | UseMethod("elo.calc") 29 | } 30 | 31 | #' @rdname elo.calc 32 | #' @export 33 | elo.calc.default <- function(wins.A, elo.A, elo.B, k, ..., adjust.A = 0, adjust.B = 0) 34 | { 35 | validate_score(wins.A) 36 | elo.up <- elo.update(wins.A = wins.A, elo.A = elo.A, elo.B = elo.B, k = k, ..., 37 | adjust.A = adjust.A, adjust.B = adjust.B) 38 | if(NCOL(elo.up) == 1) elo.up <- matrix(c(elo.up, elo.up), ncol = 2) 39 | data.frame(elo.A = elo.A + elo.up[, 1], elo.B = elo.B - elo.up[, 2]) 40 | } 41 | 42 | #' @rdname elo.calc 43 | #' @export 44 | elo.calc.formula <- function(formula, data, na.action, subset, k = NULL, ...) 45 | { 46 | Call <- match.call() 47 | Call <- Call[c(1, match(c("formula", "data", "subset", "na.action", "k"), names(Call), nomatch = 0))] 48 | Call[[1L]] <- quote(elo::elo.model.frame) 49 | Call$required.vars <- c("wins", "elos", "k") 50 | mf <- eval(Call, parent.frame()) 51 | elo.calc(mf$wins.A, mf$elo.A, mf$elo.B, k = mf$k, ..., 52 | adjust.A = mf$adj.A, adjust.B = mf$adj.B) 53 | } 54 | -------------------------------------------------------------------------------- /R/favored.R: -------------------------------------------------------------------------------- 1 | #' Classify teams that are favored to win 2 | #' 3 | #' Classify teams that are favored to win 4 | #' 5 | #' @param x An object from \code{\link{elo.run}} or \code{\link{elo.glm}}, or for the default method 6 | #' a vector representing wins.A. 7 | #' @param p.A A vector of predicted win probabilities. 8 | #' @inheritParams mse 9 | #' @name favored.elo 10 | NULL 11 | #> NULL 12 | 13 | #' @rdname favored.elo 14 | #' @export 15 | favored <- function(x, ..., subset = TRUE) 16 | { 17 | UseMethod("favored") 18 | } 19 | 20 | #' @rdname favored.elo 21 | #' @export 22 | favored.elo.run <- function(x, ..., subset = TRUE) 23 | { 24 | favored.default(x$elos[subset, sum(x$n.players) + 2], fitted(x)[subset]) 25 | } 26 | 27 | truetiefalse <- function(x) factor(x, levels = c(1, 0.5, 0), labels = c("TRUE", "(tie)", "FALSE")) 28 | 29 | #' @rdname favored.elo 30 | #' @export 31 | favored.elo.glm <- function(x, ..., subset = TRUE) 32 | { 33 | if(x$outcome == "score") return(favored.default(x$y[subset], x$fitted.values[subset])) 34 | table(truetiefalse(score(x$fitted.values[subset], 0)), 35 | truetiefalse(score(x$y[subset], 0)), dnn = c("Favored", "Actual")) 36 | } 37 | 38 | #' @rdname favored.elo 39 | #' @export 40 | favored.elo.running <- function(x, running = TRUE, discard.skipped = FALSE, ..., subset = TRUE) 41 | { 42 | if(!running) return(NextMethod()) 43 | if(!is.logical(subset)) stop("'subset' must be logical for this functionality") 44 | idx <- attr(x$running.values, "group") > (if(discard.skipped) 0 else -1) 45 | favored.default(x$y[idx & subset], x$running.values[idx & subset]) 46 | } 47 | 48 | #' @rdname favored.elo 49 | #' @export 50 | favored.elo.markovchain <- favored.elo.glm 51 | 52 | #' @rdname favored.elo 53 | #' @export 54 | favored.elo.winpct <- favored.elo.glm 55 | 56 | #' @rdname favored.elo 57 | #' @export 58 | favored.elo.colley <- favored.elo.glm 59 | 60 | #' @rdname favored.elo 61 | #' @export 62 | favored.default <- function(x, p.A, ...) 63 | { 64 | table(truetiefalse(score(p.A, 0.5)), x, dnn = c("Favored", "Actual")) 65 | } 66 | -------------------------------------------------------------------------------- /docs/bootstrap-toc.css: -------------------------------------------------------------------------------- 1 | /*! 2 | * Bootstrap Table of Contents v0.4.1 (http://afeld.github.io/bootstrap-toc/) 3 | * Copyright 2015 Aidan Feldman 4 | * Licensed under MIT (https://github.com/afeld/bootstrap-toc/blob/gh-pages/LICENSE.md) */ 5 | 6 | /* modified from https://github.com/twbs/bootstrap/blob/94b4076dd2efba9af71f0b18d4ee4b163aa9e0dd/docs/assets/css/src/docs.css#L548-L601 */ 7 | 8 | /* All levels of nav */ 9 | nav[data-toggle='toc'] .nav > li > a { 10 | display: block; 11 | padding: 4px 20px; 12 | font-size: 13px; 13 | font-weight: 500; 14 | color: #767676; 15 | } 16 | nav[data-toggle='toc'] .nav > li > a:hover, 17 | nav[data-toggle='toc'] .nav > li > a:focus { 18 | padding-left: 19px; 19 | color: #563d7c; 20 | text-decoration: none; 21 | background-color: transparent; 22 | border-left: 1px solid #563d7c; 23 | } 24 | nav[data-toggle='toc'] .nav > .active > a, 25 | nav[data-toggle='toc'] .nav > .active:hover > a, 26 | nav[data-toggle='toc'] .nav > .active:focus > a { 27 | padding-left: 18px; 28 | font-weight: bold; 29 | color: #563d7c; 30 | background-color: transparent; 31 | border-left: 2px solid #563d7c; 32 | } 33 | 34 | /* Nav: second level (shown on .active) */ 35 | nav[data-toggle='toc'] .nav .nav { 36 | display: none; /* Hide by default, but at >768px, show it */ 37 | padding-bottom: 10px; 38 | } 39 | nav[data-toggle='toc'] .nav .nav > li > a { 40 | padding-top: 1px; 41 | padding-bottom: 1px; 42 | padding-left: 30px; 43 | font-size: 12px; 44 | font-weight: normal; 45 | } 46 | nav[data-toggle='toc'] .nav .nav > li > a:hover, 47 | nav[data-toggle='toc'] .nav .nav > li > a:focus { 48 | padding-left: 29px; 49 | } 50 | nav[data-toggle='toc'] .nav .nav > .active > a, 51 | nav[data-toggle='toc'] .nav .nav > .active:hover > a, 52 | nav[data-toggle='toc'] .nav .nav > .active:focus > a { 53 | padding-left: 28px; 54 | font-weight: 500; 55 | } 56 | 57 | /* from https://github.com/twbs/bootstrap/blob/e38f066d8c203c3e032da0ff23cd2d6098ee2dd6/docs/assets/css/src/docs.css#L631-L634 */ 58 | nav[data-toggle='toc'] .nav > .active > ul { 59 | display: block; 60 | } 61 | -------------------------------------------------------------------------------- /man/elo.run.multiteam.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/elo.run.multiteam.R 3 | \name{elo.run.multiteam} 4 | \alias{elo.run.multiteam} 5 | \title{Calculate running Elos for a series of multi-team matches.} 6 | \usage{ 7 | elo.run.multiteam( 8 | formula, 9 | data, 10 | na.action, 11 | subset, 12 | k = NULL, 13 | initial.elos = NULL, 14 | ... 15 | ) 16 | } 17 | \arguments{ 18 | \item{formula}{A one-sided formula with a \code{\link{multiteam}()} object. 19 | See also the \link[=formula.specials]{the help page for formulas} for details.} 20 | 21 | \item{data}{A \code{data.frame} in which to look for objects in \code{formula}.} 22 | 23 | \item{na.action}{A function which indicates what should happen when the data contain NAs.} 24 | 25 | \item{subset}{An optional vector specifying a subset of observations.} 26 | 27 | \item{k}{A constant k-value (or a vector, where appropriate).} 28 | 29 | \item{initial.elos}{An optional named vector containing initial Elo ratings for all teams in \code{formula}. 30 | If a single (unnamed) value is supplied, that value is applied to all teams. \code{NULL} (the default) 31 | sets all Elos to 1500.} 32 | 33 | \item{...}{Other arguments (not used at this time).} 34 | } 35 | \description{ 36 | Calculate running Elos for a series of multi-team matches. 37 | } 38 | \details{ 39 | This is like \code{\link{elo.run}} (and in fact it runs \code{\link{elo.run}} in the background). 40 | The formula takes a \code{\link{multiteam}()} object, which assumes that teams "win" 41 | in a well-ordered ranking. It assumes that the first place team beats all other teams, 42 | that the second place team loses to the first but beats the others, etc. In that regard, 43 | \code{elo.run.multiteam} reduces to \code{elo.run} when the number of teams (\code{ncol(multiteam())}) is 2 44 | 45 | However, this is less flexible than \code{elo.run}, because (1) there cannot be ties; (2) it does not accept 46 | adjustments; and (3) k is constant within a "game" 47 | } 48 | \examples{ 49 | data(tournament.multiteam) 50 | elo.run.multiteam(~ multiteam(Place_1, Place_2, Place_3, Place_4), 51 | data = tournament.multiteam, subset = -28, k = 20) 52 | } 53 | -------------------------------------------------------------------------------- /man/elo.prob.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/elo.prob.R 3 | \name{elo.prob} 4 | \alias{elo.prob} 5 | \alias{elo.prob.default} 6 | \alias{elo.prob.formula} 7 | \alias{elo.prob.elo.multiteam.matrix} 8 | \title{Elo probability} 9 | \usage{ 10 | elo.prob(elo.A, ...) 11 | 12 | \method{elo.prob}{default}(elo.A, elo.B, ..., elos = NULL, adjust.A = 0, adjust.B = 0) 13 | 14 | \method{elo.prob}{formula}(formula, data, na.action, subset, ..., elos = NULL) 15 | 16 | \method{elo.prob}{elo.multiteam.matrix}(elo.A, ..., elos = NULL) 17 | } 18 | \arguments{ 19 | \item{elo.A, elo.B}{Numeric vectors of elo scores, or else vectors of teams.} 20 | 21 | \item{...}{Other arguments (not in use at this time).} 22 | 23 | \item{elos}{An optional named vector containing Elo ratings for all teams in \code{formula} 24 | or \code{elo.A} and \code{elo.B}.} 25 | 26 | \item{adjust.A, adjust.B}{Numeric vectors to adjust \code{elo.A} and \code{elo.B} by.} 27 | 28 | \item{formula}{A formula. See \link[=formula.specials]{the help page for formulas} for details.} 29 | 30 | \item{data}{A \code{data.frame} in which to look for objects in \code{formula}.} 31 | 32 | \item{na.action}{A function which indicates what should happen when the data contain NAs.} 33 | 34 | \item{subset}{An optional vector specifying a subset of observations.} 35 | } 36 | \value{ 37 | A vector of Elo probabilities. 38 | } 39 | \description{ 40 | Calculate the probability that team A beats team B. This is vectorized. 41 | } 42 | \details{ 43 | Note that \code{formula} can be missing the \code{wins.A} component. If 44 | present, it's ignored by \code{\link{elo.model.frame}}. 45 | } 46 | \examples{ 47 | elo.prob(1500, 1500) 48 | elo.prob(c(1500, 1500), c(1500, 1600)) 49 | 50 | dat <- data.frame(wins.A = c(1, 0), elo.A = c(1500, 1500), 51 | elo.B = c(1500, 1600), k = c(20, 20)) 52 | elo.prob(~ elo.A + elo.B, data = dat) 53 | 54 | ## Also works to include the wins and k: 55 | elo.prob(wins.A ~ elo.A + elo.B + k(k), data = dat) 56 | 57 | ## Also allows teams 58 | elo.prob(c("A", "B"), c("C", "C"), elos = c(A = 1500, B = 1600, C = 1500)) 59 | 60 | } 61 | \seealso{ 62 | \code{\link{elo.update}}, \code{\link{elo.calc}}, 63 | \code{elo.model.frame} 64 | } 65 | -------------------------------------------------------------------------------- /R/elo.players.R: -------------------------------------------------------------------------------- 1 | 2 | #' @rdname formula.specials 3 | #' @export 4 | players <- function(..., weights = NULL) 5 | { 6 | args <- lapply(list(...), as.character) 7 | as.elo.players.matrix(do.call(cbind, args), weights = weights) 8 | } 9 | 10 | #' @export 11 | is.na.elo.players.matrix <- function(x) rowSums(is.na(unclass(x))) > 0 12 | 13 | as.elo.players.matrix <- function(x, weights = attr(x, "weights")) 14 | { 15 | if(!is.matrix(x)) stop("'x' isn't a matrix.") 16 | if(nrow(x)*ncol(x) == 0) stop('No rows or no columns.') 17 | if(is.null(weights)) weights <- rep(1, ncol(x)) 18 | if(!is.numeric(weights) || length(weights) != ncol(x)) stop("'weights' isn't the right size.") 19 | weights <- weights / sum(weights) 20 | 21 | structure(x, class = c("elo.players.matrix", class(x)), weights = weights) 22 | } 23 | 24 | #' @export 25 | as.matrix.elo.players.matrix <- function(x, ...) 26 | { 27 | if(!is.matrix(x)) stop("x isn't already a matrix") 28 | x <- unclass(x) 29 | attr(x, "weights") <- NULL 30 | x 31 | } 32 | 33 | #' @export 34 | `[.elo.players.matrix` <- function(x, i, j, drop = FALSE) 35 | { 36 | if(!missing(j)) return(NextMethod()) 37 | as.elo.players.matrix(as.matrix(x)[i, , drop = FALSE], attr(x, "weights")) 38 | } 39 | 40 | #' @export 41 | length.elo.players.matrix <- function(x) nrow(x) 42 | 43 | #' @export 44 | weights.elo.players.matrix <- function(object, ...) attr(object, "weights") 45 | 46 | is.players <- function(x) inherits(x, "elo.players.matrix") 47 | 48 | #' @rdname formula.specials 49 | #' @export 50 | multiteam <- function(...) 51 | { 52 | args <- lapply(list(...), as.character) 53 | as.elo.multiteam.matrix(do.call(cbind, args)) 54 | } 55 | 56 | as.elo.multiteam.matrix <- function(x) 57 | { 58 | if(!is.matrix(x)) stop("'x' isn't a matrix.") 59 | if(nrow(x)*ncol(x) == 0) stop('No rows or no columns.') 60 | structure(x, class = c("elo.multiteam.matrix", class(x))) 61 | } 62 | 63 | #' @export 64 | `[.elo.multiteam.matrix` <- function(x, i, j, drop = FALSE) 65 | { 66 | if(!missing(j)) return(NextMethod()) 67 | as.elo.multiteam.matrix(unclass(x)[i, , drop = FALSE]) 68 | } 69 | 70 | #' @export 71 | length.elo.multiteam.matrix <- function(x) nrow(x) 72 | 73 | #' @export 74 | is.na.elo.multiteam.matrix <- function(x) rowSums(is.na(unclass(x))) == ncol(unclass(x)) 75 | -------------------------------------------------------------------------------- /docs/docsearch.js: -------------------------------------------------------------------------------- 1 | $(function() { 2 | 3 | // register a handler to move the focus to the search bar 4 | // upon pressing shift + "/" (i.e. "?") 5 | $(document).on('keydown', function(e) { 6 | if (e.shiftKey && e.keyCode == 191) { 7 | e.preventDefault(); 8 | $("#search-input").focus(); 9 | } 10 | }); 11 | 12 | $(document).ready(function() { 13 | // do keyword highlighting 14 | /* modified from https://jsfiddle.net/julmot/bL6bb5oo/ */ 15 | var mark = function() { 16 | 17 | var referrer = document.URL ; 18 | var paramKey = "q" ; 19 | 20 | if (referrer.indexOf("?") !== -1) { 21 | var qs = referrer.substr(referrer.indexOf('?') + 1); 22 | var qs_noanchor = qs.split('#')[0]; 23 | var qsa = qs_noanchor.split('&'); 24 | var keyword = ""; 25 | 26 | for (var i = 0; i < qsa.length; i++) { 27 | var currentParam = qsa[i].split('='); 28 | 29 | if (currentParam.length !== 2) { 30 | continue; 31 | } 32 | 33 | if (currentParam[0] == paramKey) { 34 | keyword = decodeURIComponent(currentParam[1].replace(/\+/g, "%20")); 35 | } 36 | } 37 | 38 | if (keyword !== "") { 39 | $(".contents").unmark({ 40 | done: function() { 41 | $(".contents").mark(keyword); 42 | } 43 | }); 44 | } 45 | } 46 | }; 47 | 48 | mark(); 49 | }); 50 | }); 51 | 52 | /* Search term highlighting ------------------------------*/ 53 | 54 | function matchedWords(hit) { 55 | var words = []; 56 | 57 | var hierarchy = hit._highlightResult.hierarchy; 58 | // loop to fetch from lvl0, lvl1, etc. 59 | for (var idx in hierarchy) { 60 | words = words.concat(hierarchy[idx].matchedWords); 61 | } 62 | 63 | var content = hit._highlightResult.content; 64 | if (content) { 65 | words = words.concat(content.matchedWords); 66 | } 67 | 68 | // return unique words 69 | var words_uniq = [...new Set(words)]; 70 | return words_uniq; 71 | } 72 | 73 | function updateHitURL(hit) { 74 | 75 | var words = matchedWords(hit); 76 | var url = ""; 77 | 78 | if (hit.anchor) { 79 | url = hit.url_without_anchor + '?q=' + escape(words.join(" ")) + '#' + hit.anchor; 80 | } else { 81 | url = hit.url + '?q=' + escape(words.join(" ")); 82 | } 83 | 84 | return url; 85 | } 86 | -------------------------------------------------------------------------------- /man/elo.winpct.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/elo.winpct.R 3 | \name{elo.winpct} 4 | \alias{elo.winpct} 5 | \title{Compute a (usually logistic) regression based on win percentage for a series of matches.} 6 | \usage{ 7 | elo.winpct( 8 | formula, 9 | data, 10 | family = "binomial", 11 | weights, 12 | na.action, 13 | subset, 14 | ..., 15 | running = FALSE, 16 | skip = 0 17 | ) 18 | } 19 | \arguments{ 20 | \item{formula}{A formula. See \link[=formula.specials]{the help page for formulas} for details.} 21 | 22 | \item{data}{A \code{data.frame} in which to look for objects in \code{formula}.} 23 | 24 | \item{family}{Argument passed to \code{\link[stats]{glm}}.} 25 | 26 | \item{weights}{A vector of weights. Note that these are used in calculating wins and losses but 27 | not in the regression.} 28 | 29 | \item{na.action}{A function which indicates what should happen when the data contain NAs.} 30 | 31 | \item{subset}{An optional vector specifying a subset of observations.} 32 | 33 | \item{...}{Argument passed to \code{\link[stats]{glm}}.} 34 | 35 | \item{running}{Logical, denoting whether to calculate "running" projected probabilities. If true, a model is fit for 36 | group 1 on its own to predict group 2, then groups 1 and 2 to predict 3, then groups 1 through 3 to predict 4, etc. 37 | Groups are determined in \code{formula}. Omitting a group term re-runs a glm model to predict each 38 | observation (a potentially time-consuming operation!)} 39 | 40 | \item{skip}{Integer, denoting how many groups to skip before fitting the running models. This is helpful if 41 | groups are small, where glm would have trouble converging for the first few groups. The predicted values are then 42 | set to 0.5 for the skipped groups.} 43 | } 44 | \description{ 45 | Compute a (usually logistic) regression based on win percentage for a series of matches. 46 | } 47 | \details{ 48 | Win percentages are first calculated. Anything passed to \code{\link{adjust}()} in 49 | \code{formula} is also put in the data.frame. A \code{\link{glm}} model is then 50 | run to predict wins or margin of victory. 51 | 52 | With this setup, the intercept represents the home-field advantage. Neutral fields can be indicated 53 | using the \code{\link{neutral}()} function, which sets the intercept to 0. 54 | } 55 | \examples{ 56 | elo.winpct(score(points.Home, points.Visitor) ~ team.Home + team.Visitor, data = tournament, 57 | subset = points.Home != points.Visitor) 58 | 59 | elo.winpct(mov(points.Home, points.Visitor) ~ team.Home + team.Visitor, data = tournament, 60 | family = "gaussian") 61 | } 62 | \seealso{ 63 | \code{\link[stats]{glm}}, \code{\link{summary.elo.winpct}}, \code{\link{score}}, 64 | \code{\link{mov}}, \code{\link{elo.model.frame}} 65 | } 66 | -------------------------------------------------------------------------------- /man/predict.elo.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/predict.R 3 | \name{predict.elo} 4 | \alias{predict.elo} 5 | \alias{predict.elo.run} 6 | \alias{predict.elo.run.regressed} 7 | \alias{predict.elo.run.multiteam} 8 | \alias{predict.elo.glm} 9 | \alias{predict.elo.running} 10 | \alias{predict.elo.markovchain} 11 | \alias{predict.elo.colley} 12 | \alias{predict.elo.winpct} 13 | \title{Make Predictions on an \code{elo} Object} 14 | \usage{ 15 | \method{predict}{elo.run}(object, newdata, ...) 16 | 17 | \method{predict}{elo.run.regressed}(object, newdata, regressed = FALSE, ...) 18 | 19 | \method{predict}{elo.run.multiteam}(object, newdata, ...) 20 | 21 | \method{predict}{elo.glm}(object, newdata, type = "response", ...) 22 | 23 | \method{predict}{elo.running}(object, newdata, running = TRUE, ...) 24 | 25 | \method{predict}{elo.markovchain}(object, newdata, ...) 26 | 27 | \method{predict}{elo.colley}(object, newdata, ...) 28 | 29 | \method{predict}{elo.winpct}(object, newdata, ...) 30 | } 31 | \arguments{ 32 | \item{object}{An model from which to get predictions.} 33 | 34 | \item{newdata}{A new dataset containing the same variables as the call 35 | that made \code{object}. If missing, the predicted win probabilities from 36 | \code{object} will be returned.} 37 | 38 | \item{...}{Other arguments.} 39 | 40 | \item{regressed}{See the note on \code{\link{final.elos}}.} 41 | 42 | \item{type}{See \code{\link[stats]{predict.glm}}} 43 | 44 | \item{running}{logical, denoting whether to use the running predicted values. Only makes 45 | sense if \code{newdata} is missing.} 46 | } 47 | \value{ 48 | A vector of win probabilities. 49 | } 50 | \description{ 51 | Make Predictions on an \code{elo} Object 52 | } 53 | \details{ 54 | Note that the \code{"elo.glm.running"} objects will use a model fit on all the data to predict. 55 | } 56 | \examples{ 57 | data(tournament) 58 | t1 <- head(tournament, -3) 59 | t2 <- tail(tournament, 3) 60 | results <- elo.run(score(points.Home, points.Visitor) ~ team.Home + team.Visitor, 61 | data = t1, k = 20) 62 | predict(results) 63 | predict(results, newdata = t2) 64 | 65 | results <- elo.glm(score(points.Home, points.Visitor) ~ team.Home + team.Visitor, data = t1, 66 | subset = points.Home != points.Visitor) 67 | predict(results) 68 | predict(results, newdata = t2) 69 | 70 | results <- elo.markovchain(score(points.Home, points.Visitor) ~ team.Home + team.Visitor, data = t1, 71 | subset = points.Home != points.Visitor, k = 0.7) 72 | predict(results) 73 | predict(results, newdata = t2) 74 | 75 | results <- elo.colley(score(points.Home, points.Visitor) ~ team.Home + team.Visitor, data = t1, 76 | subset = points.Home != points.Visitor) 77 | predict(results) 78 | predict(results, newdata = t2) 79 | 80 | results <- elo.winpct(score(points.Home, points.Visitor) ~ team.Home + team.Visitor, data = t1, 81 | subset = points.Home != points.Visitor, k = 0.7) 82 | predict(results) 83 | predict(results, newdata = t2) 84 | } 85 | -------------------------------------------------------------------------------- /R/elo.run.multiteam.R: -------------------------------------------------------------------------------- 1 | 2 | #' Calculate running Elos for a series of multi-team matches. 3 | #' 4 | #' @inheritParams elo.run 5 | #' @param formula A one-sided formula with a \code{\link{multiteam}()} object. 6 | #' See also the \link[=formula.specials]{the help page for formulas} for details. 7 | #' @details 8 | #' This is like \code{\link{elo.run}} (and in fact it runs \code{\link{elo.run}} in the background). 9 | #' The formula takes a \code{\link{multiteam}()} object, which assumes that teams "win" 10 | #' in a well-ordered ranking. It assumes that the first place team beats all other teams, 11 | #' that the second place team loses to the first but beats the others, etc. In that regard, 12 | #' \code{elo.run.multiteam} reduces to \code{elo.run} when the number of teams (\code{ncol(multiteam())}) is 2 13 | #' 14 | #' However, this is less flexible than \code{elo.run}, because (1) there cannot be ties; (2) it does not accept 15 | #' adjustments; and (3) k is constant within a "game" 16 | #' 17 | #' @examples 18 | #' data(tournament.multiteam) 19 | #' elo.run.multiteam(~ multiteam(Place_1, Place_2, Place_3, Place_4), 20 | #' data = tournament.multiteam, subset = -28, k = 20) 21 | #' @export 22 | elo.run.multiteam <- function(formula, data, na.action, subset, k = NULL, initial.elos = NULL, ...) 23 | { 24 | Call <- match.call() 25 | Call[[1L]] <- quote(elo::elo.model.frame) 26 | Call$required.vars <- c("elos", "k", "group", "regress") 27 | Call$ncol.k <- 2 28 | Call$ncol.elos <- 1 29 | mf <- eval(Call, parent.frame()) 30 | if(nrow(mf) == 0) stop("No (non-missing) observations") 31 | Terms <- stats::terms(mf) 32 | 33 | if(any(mf$adjust.A != 0)) warning("Any adjustments using 'adjust()' are being ignored.") 34 | mf2 <- multiteam_model_frame(mf) 35 | er <- elo.run(wins.A ~ elo.A + elo.B + k(k) + group(group) + regress(regress, to = attr(mf$regress, "to"), by = attr(mf$regress, "by")), data = mf2, ...) 36 | er$Call <- Call 37 | er$terms <- Terms 38 | er$na.action <- stats::na.action(mf) 39 | er$n.matches <- nrow(mf) 40 | class(er) <- c("elo.run.multiteam", class(er)) 41 | er 42 | } 43 | 44 | multiteam_model_frame <- function(mf) 45 | { 46 | mf$i <- seq_len(nrow(mf)) 47 | mf2 <- lapply(mf$i, function(i) { 48 | row <- as.character(mf$elo.A[i, ]) 49 | row <- row[!is.na(row)] 50 | if(length(row) < 2) stop("One or more row of 'multiteam()' has fewer than two (non-NA) teams") 51 | out <- as.data.frame(t(utils::combn(row, 2)), stringsAsFactors = FALSE) 52 | names(out) <- c("elo.A", "elo.B") 53 | out$wins.A <- +(match(out$elo.A, row) < match(out$elo.B, row)) 54 | out$i <- i 55 | out 56 | }) 57 | mf2 <- do.call(rbind, c(list(stringsAsFactors = FALSE), mf2)) 58 | mf2 <- merge(mf2, mf[names(mf) != "elo.A"], by = "i", sort = TRUE) 59 | mf2$group <- !duplicated(mf2$i, fromLast = TRUE) & check_group_regress(mf2$group, gt.zero = TRUE) 60 | mf2$regress <- !duplicated(mf2$i, fromLast = TRUE) & check_group_regress(mf2$regress) 61 | mf2 62 | } 63 | -------------------------------------------------------------------------------- /vignettes/players.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Adjusting for Players in the Elo Framework" 3 | author: "Ethan Heinzen" 4 | output: 5 | rmarkdown::html_vignette: 6 | toc: true 7 | vignette: > 8 | %\VignetteIndexEntry{Adjusting for Players in the Elo Framework} 9 | %\VignetteEngine{knitr::rmarkdown} 10 | %\VignetteEncoding{UTF-8} 11 | --- 12 | 13 | # Adjusting for Players in the Elo Framework 14 | 15 | When there are distinct players that you want to model, 16 | there are two different approaches that might be helpful. 17 | 18 | If you know the adjustment you want to give a team based on the presence of 19 | one of its players, you should use the `adjust()` function. 20 | 21 | If you want to *model* the player's impact on the Elo rating, 22 | it can be helpful to use the `players()` function. 23 | 24 | Consider American Football, in which the quarterback can exert a lot of influence 25 | on whether a team wins or not. If, halfway through a season, a good quarterback 26 | gets injured and no longer plays, a backup quarterback would fill in, but the 27 | team would not expect to keep its high Elo rating. 28 | 29 | Consider this set of matchups: 30 | 31 | ```{r} 32 | games <- data.frame( 33 | team1 = c("A", "B", "A", "A"), 34 | team2 = c("B", "C", "C", "B"), 35 | quarterback1 = c("1", "2", "1", "4"), 36 | quarterback2 = c("2", "3", "3", "2"), 37 | won = c(1, 1, 1, 0) 38 | ) 39 | ``` 40 | 41 | We run `elo.run()` with the `players()` function. Behind the scenes, this is 42 | calculating an individual Elo score for the team and the quarterback. 43 | For updates, it sums the two Elos together for a composite Elo, compares this to 44 | the opponent's composite Elo, and determines the Elo update. It divides this 45 | update according to the weights specified. 46 | 47 | ```{r} 48 | init <- c(A = 1500, B = 1500, C = 1500, "1" = 0, "2" = 0, "3" = 0, "4" = 0) 49 | er <- elo.run( 50 | won ~ players(team1, quarterback1, weights = c(0.75, 0.25)) + 51 | players(team2, quarterback2, weights = c(0.75, 0.25)), 52 | data = games, 53 | k = 40, 54 | initial.elos = init 55 | ) 56 | summary(er) 57 | final.elos(er) 58 | ``` 59 | 60 | You can see that quarterback "1" adds 9 points to the effective Elo rating 61 | when he plays, and that quarterback "4" subtracts 5 points. 62 | 63 | This also plays out in predictions on future games: 64 | 65 | ```{r} 66 | 67 | future.game <- data.frame( 68 | team1 = "A", 69 | team2 = "C", 70 | quarterback1 = c("1", "4"), 71 | quarterback2 = "3" 72 | ) 73 | 74 | predict(er, newdata = future.game) 75 | ``` 76 | 77 | Notice that the predicted win percentage is slightly lower with quarterback 4. 78 | 79 | # Another Application 80 | 81 | This methodology has been used before to model an Ultimate Frisbee season. 82 | In this case, the players on the field at a given time are given a score (1 or 0) 83 | depending on whether they score. The first term is a `players(player1, ..., player7)`, 84 | and the second term (because the opponent's *players* weren't kept track of) 85 | was simply the name of the opponent. 86 | 87 | 88 | 89 | 90 | 91 | 92 | 93 | 94 | 95 | -------------------------------------------------------------------------------- /tests/testthat/test_elo.markovchain.R: -------------------------------------------------------------------------------- 1 | context("Testing the elo.markovchain function") 2 | 3 | ########################################################################################################### 4 | #### Do some simple checks 5 | ########################################################################################################### 6 | 7 | trn <- tournament 8 | trn$diff <- score(trn$points.Home, trn$points.Visitor) 9 | trn <- trn[trn$diff %in% 0:1, ] 10 | trn$neut <- replace(rep(0, times = nrow(trn)), c(3, 30), 1) 11 | 12 | test_that("elo.markovchain is working correctly", { 13 | tmp.mc <- elo.markovchain(score(points.Home, points.Visitor) ~ team.Home + team.Visitor, data = trn, k = 0.7) 14 | 15 | expect_equal(tmp.mc$eigenvalue, 1) 16 | expect_equal(sum(tmp.mc$pi), 1) 17 | expect_equal(colSums(tmp.mc$transition), rep(1, ncol(tmp.mc$transition))) 18 | expect_equal(tmp.mc$n.games, as.vector(table(c(trn$team.Home, trn$team.Visitor)))) 19 | }) 20 | 21 | test_that("predict.elo.markovchain is working correctly", { 22 | tmp.mc.adj <- elo.markovchain(score(points.Home, points.Visitor) ~ adjust(team.Home, neut) + team.Visitor, 23 | data = trn, k = 0.7) 24 | expect_error(predict(tmp.mc.adj, data.frame(team.Home = "Blundering Baboons", team.Visitor = "Athletic Armadillos")), 25 | "'neut' not found") 26 | 27 | tmp.mc.neu <- elo.markovchain(score(points.Home, points.Visitor) ~ team.Home + team.Visitor + neutral(neut), 28 | data = trn, k = 0.7) 29 | expect_error(predict(tmp.mc.neu, data.frame(team.Home = "Blundering Baboons", team.Visitor = "Athletic Armadillos")), 30 | "'neut' not found") 31 | 32 | tmp.mc <- elo.markovchain(score(points.Home, points.Visitor) ~ team.Home + team.Visitor, data = trn, k = 0.7) 33 | expect_error(predict(tmp.mc, data.frame(team.Home = "Blundering Baboons", team.Visitor = "Athletic Armadillos")), NA) 34 | }) 35 | 36 | test_that("elo.markovchain(running=TRUE) works", { 37 | tmp.mc.run <- elo.markovchain(diff ~ team.Home + team.Visitor + group(week), 38 | data = trn, k = 0.7, running = TRUE, skip = 5) 39 | 40 | expect_equal(fitted(tmp.mc.run)[1:19], rep(0.5, 19)) 41 | 42 | tmp.mc <- elo.markovchain(diff ~ team.Home + team.Visitor, data = trn, k = 0.7) 43 | expect_equal(predict(tmp.mc, newdata=head(trn, 2)), predict(tmp.mc.run, newdata=head(trn, 2))) 44 | 45 | 46 | }) 47 | 48 | 49 | test_that("adjust() works in elo.markovchain()", { 50 | tmp.mc.adj0 <- elo.markovchain(diff ~ team.Home + adjust(team.Visitor, 0) + group(week), data = trn, 51 | running = TRUE, skip = 5, k = 0.7) 52 | tmp.mc.adj1 <- elo.markovchain(diff ~ team.Home + adjust(team.Visitor, c(rep(0, 50), 1)) + group(week), 53 | data = trn, running = TRUE, skip = 5, k = 0.7) 54 | tmp.mc.noad <- elo.markovchain(diff ~ team.Home + team.Visitor + group(week), data = trn, 55 | running = TRUE, skip = 5, k = 0.7) 56 | expect_equal(fitted(tmp.mc.adj0), fitted(tmp.mc.adj1)) 57 | expect_equal(fitted(tmp.mc.adj0), fitted(tmp.mc.noad)) 58 | }) 59 | -------------------------------------------------------------------------------- /man/elo.glm.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/elo.glm.R 3 | \name{elo.glm} 4 | \alias{elo.glm} 5 | \title{Compute a (usually logistic) regression model for a series of matches.} 6 | \usage{ 7 | elo.glm( 8 | formula, 9 | data, 10 | family = "binomial", 11 | weights, 12 | na.action, 13 | subset, 14 | ..., 15 | running = FALSE, 16 | skip = 0 17 | ) 18 | } 19 | \arguments{ 20 | \item{formula}{A formula. See \link[=formula.specials]{the help page for formulas} for details.} 21 | 22 | \item{data}{A \code{data.frame} in which to look for objects in \code{formula}.} 23 | 24 | \item{family}{Argument passed to \code{\link[stats]{glm}}.} 25 | 26 | \item{weights}{Argument passed to \code{\link[stats]{glm}}.} 27 | 28 | \item{na.action}{A function which indicates what should happen when the data contain NAs.} 29 | 30 | \item{subset}{An optional vector specifying a subset of observations.} 31 | 32 | \item{...}{Argument passed to \code{\link[stats]{glm}}.} 33 | 34 | \item{running}{Logical, denoting whether to calculate "running" projected probabilities. If true, a model is fit for 35 | group 1 on its own to predict group 2, then groups 1 and 2 to predict 3, then groups 1 through 3 to predict 4, etc. 36 | Groups are determined in \code{formula}. Omitting a group term re-runs a glm model to predict each 37 | observation (a potentially time-consuming operation!)} 38 | 39 | \item{skip}{Integer, denoting how many groups to skip before fitting the running models. This is helpful if 40 | groups are small, where glm would have trouble converging for the first few groups. The predicted values are then 41 | set to 0.5 for the skipped groups.} 42 | } 43 | \value{ 44 | An object of class \code{c("elo.glm", "glm")}. If \code{running==TRUE}, the class \code{"elo.glm.running"} 45 | is prepended. 46 | } 47 | \description{ 48 | Compute a (usually logistic) regression model for a series of matches. 49 | } 50 | \details{ 51 | The formula syntax is the same as other \code{elo} functions. A data.frame 52 | of indicator variables is built, where an entry is 1 if a team is home, 0 if 53 | a team didn't play, and -1 if a team is a visitor. Anything passed to \code{\link{adjust}()} in 54 | \code{formula} is also put in the data.frame. A \code{\link{glm}} model is then 55 | run to predict wins or margin of victory. 56 | 57 | With this setup, the intercept represents the home-field advantage. Neutral fields can be indicated 58 | using the \code{\link{neutral}()} function, which sets the intercept to 0. 59 | 60 | Note that any weights specified in \code{players()} will be ignored. 61 | 62 | This is essentially the Bradley-Terry model. 63 | } 64 | \examples{ 65 | data(tournament) 66 | elo.glm(score(points.Home, points.Visitor) ~ team.Home + team.Visitor, data = tournament, 67 | subset = points.Home != points.Visitor) 68 | elo.glm(mov(points.Home, points.Visitor) ~ team.Home + team.Visitor, data = tournament, 69 | family = "gaussian") 70 | } 71 | \references{ 72 | https://en.wikipedia.org/wiki/Bradley%E2%80%93Terry_model 73 | } 74 | \seealso{ 75 | \code{\link[stats]{glm}}, \code{\link{summary.elo.glm}}, \code{\link{score}}, 76 | \code{\link{mov}}, \code{\link{elo.model.frame}} 77 | } 78 | -------------------------------------------------------------------------------- /man/elo.colley.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/elo.colley.R 3 | \name{elo.colley} 4 | \alias{elo.colley} 5 | \title{Compute a Colley matrix model for a matchup.} 6 | \usage{ 7 | elo.colley( 8 | formula, 9 | data, 10 | family = "binomial", 11 | weights, 12 | na.action, 13 | subset, 14 | k = 1, 15 | ..., 16 | running = FALSE, 17 | skip = 0 18 | ) 19 | } 20 | \arguments{ 21 | \item{formula}{A formula. See \link[=formula.specials]{the help page for formulas} for details.} 22 | 23 | \item{data}{A \code{data.frame} in which to look for objects in \code{formula}.} 24 | 25 | \item{family}{Argument passed to \code{\link[stats]{glm}}.} 26 | 27 | \item{weights}{A vector of weights. Note that these weights are used in the Colley matrix creation, 28 | but not the regression.} 29 | 30 | \item{na.action}{A function which indicates what should happen when the data contain NAs.} 31 | 32 | \item{subset}{An optional vector specifying a subset of observations.} 33 | 34 | \item{k}{The fraction of a win to be assigned to the winning team. See "details".} 35 | 36 | \item{...}{Argument passed to \code{\link[stats]{glm}}.} 37 | 38 | \item{running}{Logical, denoting whether to calculate "running" projected probabilities. If true, a model is fit for 39 | group 1 on its own to predict group 2, then groups 1 and 2 to predict 3, then groups 1 through 3 to predict 4, etc. 40 | Groups are determined in \code{formula}. Omitting a group term re-runs a glm model to predict each 41 | observation (a potentially time-consuming operation!)} 42 | 43 | \item{skip}{Integer, denoting how many groups to skip before fitting the running models. This is helpful if 44 | groups are small, where glm would have trouble converging for the first few groups. The predicted values are then 45 | set to 0.5 for the skipped groups.} 46 | } 47 | \description{ 48 | Compute a Colley matrix model for a matchup. 49 | } 50 | \details{ 51 | See the vignette for details on this method. 52 | The differences in assigned scores (from the coefficients of the Colley matrix regression) are fed into a logistic 53 | regression model to predict wins or (usually) a linear model to predict margin of victory. 54 | In this setting, 'k' indicates the fraction of a win to be assigned to the winning team 55 | (and the fraction of a loss to be assigned to the losing team); setting \code{k = 1} (the default) 56 | emits the "Bias Free" ranking method presented by Colley. 57 | It is also possible to adjust the regression by setting the second argument of 58 | \code{\link{adjust}()}. As in \code{\link{elo.glm}}, 59 | the intercept represents the home-field advantage. Neutral fields can be indicated 60 | using the \code{\link{neutral}()} function, which sets the intercept to 0. 61 | } 62 | \examples{ 63 | elo.colley(score(points.Home, points.Visitor) ~ team.Home + team.Visitor, data = tournament, 64 | subset = points.Home != points.Visitor) 65 | } 66 | \references{ 67 | Colley W.N. Colley's Bias Free College Football Ranking Method: The Colley Matrix Explained. 2002. 68 | } 69 | \seealso{ 70 | \code{\link[stats]{glm}}, \code{\link{summary.elo.colley}}, \code{\link{score}}, 71 | \code{\link{mov}}, \code{\link{elo.model.frame}} 72 | } 73 | -------------------------------------------------------------------------------- /tests/testthat/test_elo.model.frame.R: -------------------------------------------------------------------------------- 1 | context("Testing the elo.model.frame function") 2 | 3 | ########################################################################################################### 4 | #### Do some simple checks 5 | ########################################################################################################### 6 | 7 | test_that("Basic model.frame stuff works", { 8 | expect_identical( 9 | dim(elo.model.frame(wins.A ~ team.A + team.B, data = dat, k = 20)), 10 | c(3L, 4L) 11 | ) 12 | 13 | expect_identical( 14 | dim(elo.model.frame(wins.A ~ team.A + team.B, data = dat, k = 20, 15 | required.vars = c("wins", "elos", "k"))), 16 | c(3L, 6L) 17 | ) 18 | 19 | expect_identical( 20 | dim(elo.model.frame(wins.A ~ team.A + team.B, data = dat, k = 20, 21 | required.vars = c("wins", "elos", "k", "group", "regress", "neutral", "weights"))), 22 | c(3L, 10L) 23 | ) 24 | 25 | expect_identical( 26 | elo.model.frame(wins.A ~ team.A + team.B, data = dat, required.vars = c("neutral", "weights"))$home.field, 27 | rep(1, nrow(dat)) 28 | ) 29 | 30 | expect_identical( 31 | elo.model.frame(wins.A ~ team.A + team.B, data = dat, required.vars = c("neutral", "weights"))$weights, 32 | rep(1, nrow(dat)) 33 | ) 34 | 35 | expect_identical( 36 | dim(elo.model.frame(~ team.A + team.B, data = dat)), 37 | c(3L, 4L) 38 | ) 39 | }) 40 | 41 | dat2 <- dat 42 | dat2$k.column <- "a" 43 | dat2$wins.A[2] <- 2 44 | dat2$neutral <- rep(2, nrow(dat2)) 45 | 46 | test_that("Certain errors are issued appropriately", { 47 | expect_error(elo.model.frame(wins.A ~ team.A, data = dat), "specified correctly") 48 | expect_error(elo.model.frame(~ team.A + team.B + k(k.column), data = dat, required.vars = c("wins", "elos")), 49 | "A 'wins' component") 50 | expect_error(elo.model.frame(wins.A ~ team.A + team.B, data = dat, required.vars = c("k", "elos")), 51 | "'k' is not in") 52 | expect_warning(elo.model.frame(wins.A ~ team.A + team.B + k(k.column), data = dat, k = 20), 53 | "argument being ignored") 54 | expect_error(elo.model.frame(wins.A ~ team.A + team.B, data = dat2, k = 20, required.vars = c("wins", "elos")), 55 | "between 0 and 1") 56 | expect_error(elo.model.frame(~ team.A + team.B + k(k.column), data = dat2, required.vars = c("k", "elos")), 57 | "numeric and non-NA") 58 | expect_warning(elo.model.frame(~ team.A + team.B + neutral(neutral), data = dat2, required.vars = "neutral"), 59 | "values aren't 0 or 1") 60 | expect_error(elo.model.frame(wins.A ~ team.A + team.B + k(k.column), data = dat2), NA) 61 | }) 62 | 63 | test_that("is.na(adjust()) works (#41)", { 64 | expect_true(all(is.na(adjust(1:5, NA_real_)))) 65 | expect_true(sum(is.na(adjust(1:3, c(1, NA, 3)))) == 1) 66 | expect_error(elo.model.frame(wins.A ~ adjust(team.A, NA_real_) + team.B, data = dat, k = 20), "non-missing") 67 | }) 68 | 69 | test_that("elo.model.frame() obeys na.action w.r.t. adjustments (#40)", { 70 | expect_equal(dim(elo.model.frame(replace(wins.A, 1, NA) ~ adjust(team.A, 10) + team.B, 71 | data = dat, k = 20, required.vars = c("elos", "k"))), c(2, 5)) 72 | }) 73 | -------------------------------------------------------------------------------- /R/elo.prob.R: -------------------------------------------------------------------------------- 1 | #' Elo probability 2 | #' 3 | #' Calculate the probability that team A beats team B. This is vectorized. 4 | #' 5 | #' @inheritParams elo.calc 6 | #' @param elo.A,elo.B Numeric vectors of elo scores, or else vectors of teams. 7 | #' @param elos An optional named vector containing Elo ratings for all teams in \code{formula} 8 | #' or \code{elo.A} and \code{elo.B}. 9 | #' @return A vector of Elo probabilities. 10 | #' @details 11 | #' Note that \code{formula} can be missing the \code{wins.A} component. If 12 | #' present, it's ignored by \code{\link{elo.model.frame}}. 13 | #' @seealso \code{\link{elo.update}}, \code{\link{elo.calc}}, 14 | #' \code{elo.model.frame} 15 | #' @examples 16 | #' elo.prob(1500, 1500) 17 | #' elo.prob(c(1500, 1500), c(1500, 1600)) 18 | #' 19 | #' dat <- data.frame(wins.A = c(1, 0), elo.A = c(1500, 1500), 20 | #' elo.B = c(1500, 1600), k = c(20, 20)) 21 | #' elo.prob(~ elo.A + elo.B, data = dat) 22 | #' 23 | #' ## Also works to include the wins and k: 24 | #' elo.prob(wins.A ~ elo.A + elo.B + k(k), data = dat) 25 | #' 26 | #' ## Also allows teams 27 | #' elo.prob(c("A", "B"), c("C", "C"), elos = c(A = 1500, B = 1600, C = 1500)) 28 | #' 29 | #' @name elo.prob 30 | NULL 31 | #> NULL 32 | 33 | #' @rdname elo.prob 34 | #' @export 35 | elo.prob <- function(elo.A, ...) 36 | { 37 | UseMethod("elo.prob") 38 | } 39 | 40 | #' @rdname elo.prob 41 | #' @export 42 | elo.prob.default <- function(elo.A, elo.B, ..., elos = NULL, adjust.A = 0, adjust.B = 0) 43 | { 44 | if(!is.numeric(elo.A) || !is.numeric(elo.B)) 45 | { 46 | all.teams <- character(0) 47 | if(!is.numeric(elo.A)) 48 | { 49 | if(!is.players(elo.A)) elo.A <- players(elo.A) 50 | if(anyNA(elo.A)) stop("NAs were found in elo.A; check that it can be coerced to character.") 51 | all.teams <- as.character(elo.A) 52 | } 53 | if(!is.numeric(elo.B)) 54 | { 55 | if(!is.players(elo.B)) elo.B <- players(elo.B) 56 | if(anyNA(elo.B)) stop("NAs were found in elo.B; check that it can be coerced to character.") 57 | all.teams <- c(all.teams, as.character(elo.B)) 58 | } 59 | 60 | all.teams <- sort(unique(all.teams)) 61 | elos <- check_named_elos(elos, all.teams) 62 | 63 | if(!is.numeric(elo.A)) elo.A <- rowSums(matrix(elos[elo.A], nrow = nrow(elo.A))) 64 | if(!is.numeric(elo.B)) elo.B <- rowSums(matrix(elos[elo.B], nrow = nrow(elo.B))) 65 | } 66 | 67 | unname(1/(1 + 10^(((elo.B + adjust.B) - (elo.A + adjust.A))/400.0))) 68 | } 69 | 70 | #' @rdname elo.prob 71 | #' @export 72 | elo.prob.formula <- function(formula, data, na.action, subset, ..., elos = NULL) 73 | { 74 | Call <- match.call() 75 | Call <- Call[c(1, match(c("formula", "data", "subset", "na.action"), names(Call), nomatch = 0))] 76 | Call[[1L]] <- quote(elo::elo.model.frame) 77 | mf <- eval(Call, parent.frame()) 78 | 79 | elo.prob(mf$elo.A, mf$elo.B, ..., adjust.A = mf$adj.A, adjust.B = mf$adj.B, elos = elos) 80 | } 81 | 82 | #' @rdname elo.prob 83 | #' @export 84 | elo.prob.elo.multiteam.matrix <- function(elo.A, ..., elos = NULL) 85 | { 86 | elo.A <- unclass(elo.A) 87 | all.teams <- sort(unique(as.vector(elo.A))) 88 | elos <- check_named_elos(elos, all.teams) 89 | 90 | elo.A <- matrix(elos[elo.A], nrow = nrow(elo.A)) 91 | out <- 10^(elo.A/400.0) 92 | out / rowSums(out, na.rm = TRUE) 93 | } 94 | -------------------------------------------------------------------------------- /man/elo.markovchain.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/elo.markovchain.R 3 | \name{elo.markovchain} 4 | \alias{elo.markovchain} 5 | \title{Compute a Markov chain model for a series of matches.} 6 | \usage{ 7 | elo.markovchain( 8 | formula, 9 | data, 10 | family = "binomial", 11 | weights, 12 | na.action, 13 | subset, 14 | k = NULL, 15 | ..., 16 | running = FALSE, 17 | skip = 0 18 | ) 19 | } 20 | \arguments{ 21 | \item{formula}{A formula. See \link[=formula.specials]{the help page for formulas} for details.} 22 | 23 | \item{data}{A \code{data.frame} in which to look for objects in \code{formula}.} 24 | 25 | \item{family}{Argument passed to \code{\link[stats]{glm}}.} 26 | 27 | \item{weights}{A vector of weights. Note that these weights are used in the Markov Chain model, 28 | but not the regression.} 29 | 30 | \item{na.action}{A function which indicates what should happen when the data contain NAs.} 31 | 32 | \item{subset}{An optional vector specifying a subset of observations.} 33 | 34 | \item{k}{The probability that the winning team is better given that they won. See details.} 35 | 36 | \item{...}{Argument passed to \code{\link[stats]{glm}}.} 37 | 38 | \item{running}{Logical, denoting whether to calculate "running" projected probabilities. If true, a model is fit for 39 | group 1 on its own to predict group 2, then groups 1 and 2 to predict 3, then groups 1 through 3 to predict 4, etc. 40 | Groups are determined in \code{formula}. Omitting a group term re-runs a glm model to predict each 41 | observation (a potentially time-consuming operation!)} 42 | 43 | \item{skip}{Integer, denoting how many groups to skip before fitting the running models. This is helpful if 44 | groups are small, where glm would have trouble converging for the first few groups. The predicted values are then 45 | set to 0.5 for the skipped groups.} 46 | } 47 | \description{ 48 | Compute a Markov chain model for a series of matches. 49 | } 50 | \details{ 51 | See the vignette for details on this method. The probabilities we call 'k' purely for convenience. 52 | The differences in assigned scores (from the stationary distribution pi) are fed into a logistic 53 | regression model to predict wins or (usually) a linear model to predict margin of victory. 54 | It is also possible to adjust the regression by setting the second argument of 55 | \code{\link{adjust}()}. As in \code{\link{elo.glm}}, 56 | the intercept represents the home-field advantage. Neutral fields can be indicated 57 | using the \code{\link{neutral}()} function, which sets the intercept to 0. 58 | 59 | Note that by assigning probabilities in the right way, this function emits the 60 | Logistic Regression Markov Chain model (LRMC). 61 | } 62 | \examples{ 63 | elo.markovchain(score(points.Home, points.Visitor) ~ team.Home + team.Visitor, data = tournament, 64 | subset = points.Home != points.Visitor, k = 0.7) 65 | 66 | elo.markovchain(mov(points.Home, points.Visitor) ~ team.Home + team.Visitor, family = "gaussian", 67 | data = tournament, k = 0.7) 68 | } 69 | \references{ 70 | Kvam, P. and Sokol, J.S. A logistic regression/Markov chain model for NCAA basketball. 71 | Naval Research Logistics. 2006. 53; 788-803. 72 | } 73 | \seealso{ 74 | \code{\link[stats]{glm}}, \code{\link{summary.elo.markovchain}}, \code{\link{score}}, 75 | \code{\link{mov}}, \code{\link{elo.model.frame}} 76 | } 77 | -------------------------------------------------------------------------------- /man/elo.run.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/elo.run.R 3 | \name{elo.run} 4 | \alias{elo.run} 5 | \title{Calculate running Elos for a series of matches.} 6 | \usage{ 7 | elo.run( 8 | formula, 9 | data, 10 | na.action, 11 | subset, 12 | k = NULL, 13 | initial.elos = NULL, 14 | ..., 15 | prob.fun = elo.prob, 16 | update.fun = elo.update, 17 | verbose = TRUE 18 | ) 19 | } 20 | \arguments{ 21 | \item{formula}{A formula. See \link[=formula.specials]{the help page for formulas} for details.} 22 | 23 | \item{data}{A \code{data.frame} in which to look for objects in \code{formula}.} 24 | 25 | \item{na.action}{A function which indicates what should happen when the data contain NAs.} 26 | 27 | \item{subset}{An optional vector specifying a subset of observations.} 28 | 29 | \item{k}{A constant k-value (or a vector, where appropriate).} 30 | 31 | \item{initial.elos}{An optional named vector containing initial Elo ratings for all teams in \code{formula}. 32 | If a single (unnamed) value is supplied, that value is applied to all teams. \code{NULL} (the default) 33 | sets all Elos to 1500.} 34 | 35 | \item{...}{Other arguments (not used at this time).} 36 | 37 | \item{prob.fun}{A function with at least 4 arguments: elo.A, elo.B, adjust.A, and adjust.B. It should return a predicted probability 38 | that team A wins. The values passed in will be scalars, and a scalar is expected as output.} 39 | 40 | \item{update.fun}{A function with at least 6 arguments: the same as \code{\link{elo.update.default}}. The function takes 41 | in the Elos, the win indicator, k, and any adjustments, and returns a value by which to update the Elos. The values passed in 42 | will be scalars, and a scalar is expected as output.} 43 | 44 | \item{verbose}{Should a message be issued when R is used (over C++)?} 45 | } 46 | \value{ 47 | An object of class \code{"elo.run"} or class \code{"elo.run.regressed"}. 48 | } 49 | \description{ 50 | Calculate running Elos for a series of matches. 51 | } 52 | \details{ 53 | \code{elo.run} is run two different ways: the first (default) uses C++ and may be up to 50 times faster, 54 | while the second (when \code{prob.fun} or \code{update.fun} are specified) uses R but also supports custom update functions. 55 | Prefer the first unless you really need a custom update function. 56 | } 57 | \examples{ 58 | data(tournament) 59 | elo.run(score(points.Home, points.Visitor) ~ team.Home + team.Visitor, 60 | data = tournament, k = 20) 61 | 62 | # Create non-constant 'k' 63 | elo.run(score(points.Home, points.Visitor) ~ team.Home + team.Visitor + 64 | k(20*log(abs(points.Home - points.Visitor) + 1)), data = tournament) 65 | 66 | # Adjust Elo for, e.g., home-field advantage 67 | elo.run(score(points.Home, points.Visitor) ~ adjust(team.Home, 30) + team.Visitor, 68 | data = tournament, k = 20) 69 | 70 | tournament$home.field <- 30 71 | elo.run(score(points.Home, points.Visitor) ~ adjust(team.Home, home.field) + team.Visitor, 72 | data = tournament, k = 20) 73 | 74 | # Regress the Elos back toward 1500 at the end of the half-season 75 | elo.run(score(points.Home, points.Visitor) ~ adjust(team.Home, 30) + 76 | team.Visitor + regress(half, 1500, 0.2), data = tournament, k = 20) 77 | 78 | } 79 | \seealso{ 80 | \code{\link{score}}, \link{elo.run.helpers}{elo.run helpers}, \code{\link{elo.calc}}, 81 | \code{\link{elo.update}}, \code{\link{elo.prob}}, \code{\link{elo.model.frame}}. 82 | } 83 | -------------------------------------------------------------------------------- /R/eloRun2.R: -------------------------------------------------------------------------------- 1 | eloRun2 <- function(teamA, teamB, weightsA, weightsB, winsA, k, adjTeamA, adjTeamB, regress, to, by, regressUnused, group, initialElos, flag, prob.fun, update.fun) 2 | { 3 | eloRegress <- function(eloA, to, by, idx) ifelse(idx, eloA + by*(to - eloA), eloA) 4 | 5 | nTeams <- length(initialElos) 6 | ncolA <- ncol(teamA) 7 | ncolB <- ncol(teamB) 8 | nBoth <- ncolA + ncolB 9 | nGames <- length(winsA) 10 | nRegress <- sum(regress) 11 | 12 | currElo <- numeric(nTeams) 13 | usedYet <- logical(nTeams) 14 | currElo <- initialElos # R automatically deep copies 15 | groupElo <- numeric(nTeams) 16 | groupElo <- initialElos # R automatically deep copies 17 | 18 | out <- matrix(0, nrow = nGames, ncol = 4 + 2*nBoth) 19 | regOut <- matrix(0, nrow = nRegress, ncol = nTeams) 20 | 21 | regRow <- 1 22 | for(i in seq_len(nGames)) 23 | { 24 | e1 <- numeric(ncolA) 25 | e2 <- numeric(ncolB) 26 | curr1 <- numeric(ncolA) 27 | curr2 <- numeric(ncolB) 28 | 29 | # get initial Elos for team A 30 | for(j in seq_len(ncolA)) 31 | { 32 | tmA <- teamA[i, j] + 1 33 | e1[j] <- groupElo[tmA] 34 | curr1[j] <- currElo[tmA] 35 | usedYet[tmA] <- TRUE 36 | out[i, j] <- tmA 37 | } 38 | 39 | # get initial Elos for team B 40 | for(l in seq_len(ncolB)) 41 | { 42 | if(flag == 2) 43 | { 44 | e2[l] <- teamB[i, l] 45 | curr2[l] <- teamB[i, l] 46 | out[i, ncolA + l] <- 0 47 | } else 48 | { 49 | tmB <- teamB[i, l] + 1 50 | e2[l] <- groupElo[tmB] 51 | curr2[l] <- currElo[tmB] 52 | usedYet[tmB] <- TRUE 53 | out[i, ncolA + l] <- tmB 54 | } 55 | } 56 | 57 | # calculate and store the update 58 | prb <- prob.fun(elo.A = sum(e1), elo.B = sum(e2), adjust.A = adjTeamA[i], adjust.B = adjTeamB[i]) 59 | updt1 <- update.fun(wins.A = winsA[i], elo.A = sum(e1), elo.B = sum(e2), k = k[i, 1], adjust.A = adjTeamA[i], adjust.B = adjTeamB[i]) 60 | updt2 <- update.fun(wins.A = winsA[i], elo.A = sum(e1), elo.B = sum(e2), k = k[i, 2], adjust.A = adjTeamA[i], adjust.B = adjTeamB[i]) * -1 61 | 62 | out[i, nBoth + 1] <- prb 63 | out[i, nBoth + 2] <- winsA[i] 64 | out[i, nBoth + 3] <- updt1 65 | out[i, nBoth + 4] <- updt2 66 | 67 | # store new Elos for team A 68 | for(j in seq_len(ncolA)) 69 | { 70 | tmp <- curr1[j] + updt1 * weightsA[j] 71 | out[i, nBoth + 4 + j] <- tmp 72 | currElo[teamA[i, j] + 1] <- tmp 73 | } 74 | 75 | # store new Elos for team B 76 | for(l in seq_len(ncolB)) 77 | { 78 | if(flag == 2) 79 | { 80 | out[i, nBoth + 4 + ncolA + l] <- curr2[l] 81 | } else 82 | { 83 | tmp <- curr2[l] + updt2 * weightsB[l] 84 | out[i, nBoth + 4 + ncolA + l] <- tmp 85 | currElo[teamB[i, l] + 1] <- tmp 86 | } 87 | } 88 | 89 | # This part is fine 90 | if(regress[i]) 91 | { 92 | currElo <- eloRegress(currElo, to, by, usedYet) 93 | regOut[regRow, ] <- currElo 94 | regRow <- regRow + 1 95 | if(!regressUnused) 96 | { 97 | for(l in seq_len(nTeams)) 98 | { 99 | usedYet[l] <- FALSE 100 | } 101 | } 102 | } 103 | 104 | if(group[i]) 105 | { 106 | groupElo = currElo; 107 | } 108 | } 109 | 110 | list(out, regOut) 111 | } 112 | 113 | -------------------------------------------------------------------------------- /R/elo.run.helpers.R: -------------------------------------------------------------------------------- 1 | 2 | #' Helper functions for \code{elo.run} 3 | #' 4 | #' \code{as.matrix} converts an Elo object into a matrix of running Elos. These are the Elos at the time of grouping, 5 | #' but before any regression takes place. 6 | #' 7 | #' \code{as.data.frame} converts the \code{"elos"} component of an object 8 | #' from \code{\link{elo.run}} into a data.frame. 9 | #' 10 | #' \code{final.elos} is a generic function to extract the last Elo per team. 11 | #' 12 | #' @param x An object of class \code{"elo.run"} or class \code{"elo.run.regressed"}. 13 | #' @param ... Other arguments (Not in use at this time). 14 | #' @param regressed Logical, denoting whether to use the post-regressed (\code{TRUE}) or 15 | #' pre-regressed (\code{FALSE}) final Elos. Note that \code{TRUE} only makes sense when the 16 | #' final Elos were regressed one last time (i.e., if the last element of the \code{regress()}) 17 | #' vector yields \code{TRUE}). 18 | #' @return A matrix, a data.frame, or a named vector. 19 | #' @examples 20 | #' e <- elo.run(score(points.Home, points.Visitor) ~ team.Home + team.Visitor + group(week), 21 | #' data = tournament, k = 20) 22 | #' head(as.matrix(e)) 23 | #' str(as.data.frame(e)) 24 | #' final.elos(e) 25 | #' @seealso \code{\link{elo.run}} 26 | #' @name elo.run.helpers 27 | NULL 28 | #> NULL 29 | 30 | #' @rdname elo.run.helpers 31 | #' @export 32 | as.matrix.elo.run <- function(x, ...) 33 | { 34 | group <- check_as_matrix(x, x$group) 35 | out <- eloRunAsMatrix(x$elos, x$initial.elos, group) 36 | colnames(out) <- x$teams 37 | out 38 | } 39 | 40 | #' @rdname elo.run.helpers 41 | #' @export 42 | as.matrix.elo.run.regressed <- function(x, ...) 43 | { 44 | group <- check_as_matrix(x, x$group, regr = TRUE) 45 | out <- eloRunRegressedAsMatrix(x$elos, x$initial.elos, x$elos.regressed, 46 | check_group_regress(x$regress), 47 | group) 48 | colnames(out) <- x$teams 49 | out 50 | } 51 | 52 | #' @rdname elo.run.helpers 53 | #' @export 54 | as.data.frame.elo.run <- function(x, ...) 55 | { 56 | out <- as.data.frame(x$elos) 57 | nm.a <- if(x$n.players[1] > 1) paste0(".", seq_len(x$n.players[1])) else "" 58 | nm.b <- if(x$n.players[2] > 1) paste0(".", seq_len(x$n.players[2])) else "" 59 | 60 | colnames(out) <- c(paste0("team.A", nm.a), paste0("team.B", nm.b), 61 | "p.A", "wins.A", "update.A", "update.B", 62 | paste0("elo.A", nm.a), paste0("elo.B", nm.b)) 63 | out[paste0("team.A", nm.a)] <- lapply(out[paste0("team.A", nm.a)], factor, levels = seq_along(x$teams), labels = x$teams) 64 | out[paste0("team.B", nm.b)] <- lapply(out[paste0("team.B", nm.b)], factor, levels = seq_along(x$teams), labels = x$teams) 65 | out 66 | } 67 | 68 | #' @rdname elo.run.helpers 69 | #' @export 70 | final.elos <- function(x, ...) 71 | { 72 | UseMethod("final.elos") 73 | } 74 | 75 | #' @rdname elo.run.helpers 76 | #' @export 77 | final.elos.elo.run <- function(x, ...) 78 | { 79 | check_final_elos(x, length(x$teams)) 80 | out <- finalElos(x$elos, length(x$teams)) 81 | names(out) <- x$teams 82 | out 83 | } 84 | 85 | #' @rdname elo.run.helpers 86 | #' @export 87 | final.elos.elo.run.regressed <- function(x, regressed = FALSE, ...) 88 | { 89 | if(regressed && !utils::tail(check_group_regress(x$regress), 1)) 90 | stop("'regressed = TRUE' only makes sense if the final Elos are regressed after the final game.") 91 | 92 | if(!regressed) return(NextMethod()) 93 | 94 | out <- x$elos.regressed[nrow(x$elos.regressed), ] 95 | names(out) <- x$teams 96 | out 97 | } 98 | 99 | -------------------------------------------------------------------------------- /vignettes/intro.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Introduction to Elo Rankings and the 'elo' Package" 3 | author: "Ethan Heinzen" 4 | output: 5 | rmarkdown::html_vignette: 6 | toc: true 7 | vignette: > 8 | %\VignetteIndexEntry{Introduction to Elo Rankings and the 'elo' Package} 9 | %\VignetteEngine{knitr::rmarkdown} 10 | %\VignetteEncoding{UTF-8} 11 | --- 12 | 13 | # Introduction to Elo Rankings 14 | 15 | Elo is a system of ratings/rankings (named after its creator, Arpad Elo) for pairwise matchups. 16 | In short, pairs of "teams" ("A" and "B") begin a match with rankings $R_A$ and $R_B$. 17 | The result ("score") of the game is coded as 0/0.5/1 for loss/tie/win, respectively. 18 | The prior expectation of this result can be expressed as 19 | $$P_A = \frac{1}{1 + 10^{(R_B - R_A) / 400}}$$ 20 | $$P_B = \frac{1}{1 + 10^{(R_A - R_B) / 400}} = 1 - P_A$$ 21 | where $$P_i$$ is the prior probability that team $i$ wins the match. 22 | 23 | After each match, ratings are updated as follows: 24 | $$R^{new}_A = R_A + K(S_A - P_A)$$ 25 | $$R^{new}_B = R_B + K(S_B - P_B) = R_B + K(1 - S_A - (1 - P_A)) = R_B - K(S_A - P_A)$$ 26 | where $S_i$ is the score of team $i$ (0/0.5/1) and $K$ is an update weight (commonly called the "k-factor"). 27 | 28 | Therefore, we see that the system as a whole (all teams) retains ("conserves") its total sum of Elo ratings; 29 | for every rating point team A gains/loses, team B loses/gains the same amount. 30 | 31 | 32 | # The `elo` Package 33 | 34 | The `elo` package includes functions to address all kinds of Elo calculations. 35 | 36 | ```{r} 37 | library(elo) 38 | ``` 39 | 40 | ## Naming Schema 41 | 42 | Most functions begin with the prefix "elo.", for easy autocompletion. 43 | 44 | - Vectors or scalars of Elo scores are denoted `elo.A` or `elo.B`. 45 | 46 | - Vectors or scalars of wins by team A are denoted by `wins.A`. 47 | 48 | - Vectors or scalars of win probabilities are denoted by `p.A`. 49 | 50 | - Vectors of team names are denoted `team.A` or `team.B`. 51 | 52 | # Basic Functions 53 | 54 | To calculate the probability team.A beats team.B, use `elo.prob()`: 55 | 56 | ```{r} 57 | elo.A <- c(1500, 1500) 58 | elo.B <- c(1500, 1600) 59 | elo.prob(elo.A, elo.B) 60 | ``` 61 | 62 | To calculate the score update after the two teams play, use `elo.update()`: 63 | 64 | ```{r} 65 | wins.A <- c(1, 0) 66 | elo.update(wins.A, elo.A, elo.B, k = 20) 67 | ``` 68 | 69 | To calculate the new Elo scores after the update, use `elo.calc()`: 70 | 71 | ```{r} 72 | elo.calc(wins.A, elo.A, elo.B, k = 20) 73 | ``` 74 | 75 | It may be helpful to calculate `wins.A` from raw scores: 76 | 77 | ```{r} 78 | points.A <- c(4, 1) 79 | points.B <- c(3, 3) 80 | elo.calc(score(points.A, points.B), elo.A, elo.B, k = 20) 81 | ``` 82 | 83 | # Formula Interface 84 | 85 | All of the "basic" functions accept formulas as input: 86 | 87 | ```{r} 88 | dat <- data.frame(elo.A = c(1500, 1500), elo.B = c(1500, 1600), 89 | wins.A = c(1, 0), k = 20) 90 | form <- wins.A ~ elo.A + elo.B + k(k) 91 | elo.prob(form, data = dat) 92 | elo.update(form, data = dat) 93 | elo.calc(form, data = dat) 94 | ``` 95 | 96 | Note that for `elo.prob()`, `formula = ` can be more succinct: 97 | 98 | ```{r} 99 | elo.prob(~ elo.A + elo.B, data = dat) 100 | ``` 101 | 102 | We can even adjust the Elos, for, e.g., home-field advantage. 103 | 104 | ```{r} 105 | elo.calc(wins.A ~ adjust(elo.A, 10) + elo.B + k(k), data = dat) 106 | ``` 107 | 108 | # Final Thoughts 109 | 110 | All of these functions assume that Elo scores are constant. The next vignette explores calculating "running" Elos. 111 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | S3method("[",elo.adjust) 4 | S3method("[",elo.k) 5 | S3method("[",elo.mov) 6 | S3method("[",elo.multiteam.matrix) 7 | S3method("[",elo.players.matrix) 8 | S3method("[",elo.regress) 9 | S3method(as.data.frame,elo.run) 10 | S3method(as.matrix,elo.players.matrix) 11 | S3method(as.matrix,elo.run) 12 | S3method(as.matrix,elo.run.regressed) 13 | S3method(auc,elo.colley) 14 | S3method(auc,elo.glm) 15 | S3method(auc,elo.markovchain) 16 | S3method(auc,elo.run) 17 | S3method(auc,elo.running) 18 | S3method(auc,elo.winpct) 19 | S3method(elo.calc,default) 20 | S3method(elo.calc,formula) 21 | S3method(elo.prob,default) 22 | S3method(elo.prob,elo.multiteam.matrix) 23 | S3method(elo.prob,formula) 24 | S3method(elo.update,default) 25 | S3method(elo.update,formula) 26 | S3method(favored,default) 27 | S3method(favored,elo.colley) 28 | S3method(favored,elo.glm) 29 | S3method(favored,elo.markovchain) 30 | S3method(favored,elo.run) 31 | S3method(favored,elo.running) 32 | S3method(favored,elo.winpct) 33 | S3method(final.elos,elo.run) 34 | S3method(final.elos,elo.run.regressed) 35 | S3method(fitted,elo.colley) 36 | S3method(fitted,elo.glm) 37 | S3method(fitted,elo.markovchain) 38 | S3method(fitted,elo.run) 39 | S3method(fitted,elo.running) 40 | S3method(fitted,elo.winpct) 41 | S3method(is.na,elo.adjust) 42 | S3method(is.na,elo.k) 43 | S3method(is.na,elo.multiteam.matrix) 44 | S3method(is.na,elo.players.matrix) 45 | S3method(length,elo.k) 46 | S3method(length,elo.multiteam.matrix) 47 | S3method(length,elo.players.matrix) 48 | S3method(mse,elo.colley) 49 | S3method(mse,elo.glm) 50 | S3method(mse,elo.markovchain) 51 | S3method(mse,elo.run) 52 | S3method(mse,elo.running) 53 | S3method(mse,elo.winpct) 54 | S3method(predict,elo.colley) 55 | S3method(predict,elo.glm) 56 | S3method(predict,elo.markovchain) 57 | S3method(predict,elo.run) 58 | S3method(predict,elo.run.multiteam) 59 | S3method(predict,elo.run.regressed) 60 | S3method(predict,elo.running) 61 | S3method(predict,elo.winpct) 62 | S3method(print,elo.colley) 63 | S3method(print,elo.markovchain) 64 | S3method(print,elo.run) 65 | S3method(print,elo.run.regressed) 66 | S3method(print,elo.winpct) 67 | S3method(print,summary.elo.colley) 68 | S3method(print,summary.elo.glm) 69 | S3method(print,summary.elo.markovchain) 70 | S3method(print,summary.elo.run) 71 | S3method(print,summary.elo.winpct) 72 | S3method(rank.teams,elo.colley) 73 | S3method(rank.teams,elo.glm) 74 | S3method(rank.teams,elo.markovchain) 75 | S3method(rank.teams,elo.run) 76 | S3method(rank.teams,elo.run.regressed) 77 | S3method(rank.teams,elo.winpct) 78 | S3method(residuals,elo.run) 79 | S3method(summary,elo.colley) 80 | S3method(summary,elo.glm) 81 | S3method(summary,elo.markovchain) 82 | S3method(summary,elo.run) 83 | S3method(summary,elo.winpct) 84 | S3method(weights,elo.players.matrix) 85 | export(adjust) 86 | export(brier) 87 | export(elo.calc) 88 | export(elo.colley) 89 | export(elo.glm) 90 | export(elo.markovchain) 91 | export(elo.model.frame) 92 | export(elo.prob) 93 | export(elo.run) 94 | export(elo.run.multiteam) 95 | export(elo.update) 96 | export(elo.winpct) 97 | export(favored) 98 | export(final.elos) 99 | export(group) 100 | export(is.score) 101 | export(k) 102 | export(mov) 103 | export(mse) 104 | export(multiteam) 105 | export(neutral) 106 | export(players) 107 | export(rank.teams) 108 | export(regress) 109 | export(score) 110 | importFrom(Rcpp,sourceCpp) 111 | importFrom(pROC,auc) 112 | importFrom(stats,fitted) 113 | importFrom(stats,predict) 114 | importFrom(stats,residuals) 115 | importFrom(stats,weights) 116 | useDynLib(elo) 117 | -------------------------------------------------------------------------------- /docs/pkgdown.js: -------------------------------------------------------------------------------- 1 | /* http://gregfranko.com/blog/jquery-best-practices/ */ 2 | (function($) { 3 | $(function() { 4 | 5 | $('.navbar-fixed-top').headroom(); 6 | 7 | $('body').css('padding-top', $('.navbar').height() + 10); 8 | $(window).resize(function(){ 9 | $('body').css('padding-top', $('.navbar').height() + 10); 10 | }); 11 | 12 | $('[data-toggle="tooltip"]').tooltip(); 13 | 14 | var cur_path = paths(location.pathname); 15 | var links = $("#navbar ul li a"); 16 | var max_length = -1; 17 | var pos = -1; 18 | for (var i = 0; i < links.length; i++) { 19 | if (links[i].getAttribute("href") === "#") 20 | continue; 21 | // Ignore external links 22 | if (links[i].host !== location.host) 23 | continue; 24 | 25 | var nav_path = paths(links[i].pathname); 26 | 27 | var length = prefix_length(nav_path, cur_path); 28 | if (length > max_length) { 29 | max_length = length; 30 | pos = i; 31 | } 32 | } 33 | 34 | // Add class to parent
  • , and enclosing
  • if in dropdown 35 | if (pos >= 0) { 36 | var menu_anchor = $(links[pos]); 37 | menu_anchor.parent().addClass("active"); 38 | menu_anchor.closest("li.dropdown").addClass("active"); 39 | } 40 | }); 41 | 42 | function paths(pathname) { 43 | var pieces = pathname.split("/"); 44 | pieces.shift(); // always starts with / 45 | 46 | var end = pieces[pieces.length - 1]; 47 | if (end === "index.html" || end === "") 48 | pieces.pop(); 49 | return(pieces); 50 | } 51 | 52 | // Returns -1 if not found 53 | function prefix_length(needle, haystack) { 54 | if (needle.length > haystack.length) 55 | return(-1); 56 | 57 | // Special case for length-0 haystack, since for loop won't run 58 | if (haystack.length === 0) { 59 | return(needle.length === 0 ? 0 : -1); 60 | } 61 | 62 | for (var i = 0; i < haystack.length; i++) { 63 | if (needle[i] != haystack[i]) 64 | return(i); 65 | } 66 | 67 | return(haystack.length); 68 | } 69 | 70 | /* Clipboard --------------------------*/ 71 | 72 | function changeTooltipMessage(element, msg) { 73 | var tooltipOriginalTitle=element.getAttribute('data-original-title'); 74 | element.setAttribute('data-original-title', msg); 75 | $(element).tooltip('show'); 76 | element.setAttribute('data-original-title', tooltipOriginalTitle); 77 | } 78 | 79 | if(ClipboardJS.isSupported()) { 80 | $(document).ready(function() { 81 | var copyButton = ""; 82 | 83 | $(".examples, div.sourceCode").addClass("hasCopyButton"); 84 | 85 | // Insert copy buttons: 86 | $(copyButton).prependTo(".hasCopyButton"); 87 | 88 | // Initialize tooltips: 89 | $('.btn-copy-ex').tooltip({container: 'body'}); 90 | 91 | // Initialize clipboard: 92 | var clipboardBtnCopies = new ClipboardJS('[data-clipboard-copy]', { 93 | text: function(trigger) { 94 | return trigger.parentNode.textContent; 95 | } 96 | }); 97 | 98 | clipboardBtnCopies.on('success', function(e) { 99 | changeTooltipMessage(e.trigger, 'Copied!'); 100 | e.clearSelection(); 101 | }); 102 | 103 | clipboardBtnCopies.on('error', function() { 104 | changeTooltipMessage(e.trigger,'Press Ctrl+C or Command+C to copy'); 105 | }); 106 | }); 107 | } 108 | })(window.jQuery || window.$) 109 | -------------------------------------------------------------------------------- /R/summary.R: -------------------------------------------------------------------------------- 1 | 2 | #' Summarize an \code{elo} Object 3 | #' 4 | #' @param object An object to summarize. 5 | #' @param ... Other arguments 6 | #' @return A summary of \code{object}. 7 | #' @examples 8 | #' summary(elo.run(score(points.Home, points.Visitor) ~ team.Home + team.Visitor, 9 | #' data = tournament, k = 20)) 10 | #' summary(elo.glm(score(points.Home, points.Visitor) ~ team.Home + team.Visitor, 11 | #' data = tournament)) 12 | #' mc <- elo.markovchain(score(points.Home, points.Visitor) ~ team.Home + team.Visitor, 13 | #' data = tournament, subset = points.Home != points.Visitor, k = 0.7) 14 | #' summary(mc) 15 | #' co <- elo.colley(score(points.Home, points.Visitor) ~ team.Home + team.Visitor, 16 | #' data = tournament, subset = points.Home != points.Visitor) 17 | #' summary(co) 18 | #' wp <- elo.winpct(score(points.Home, points.Visitor) ~ team.Home + team.Visitor, 19 | #' data = tournament, subset = points.Home != points.Visitor, k = 0.7) 20 | #' summary(wp) 21 | #' @seealso \code{\link{favored}}, \code{\link{auc.elo.run}}, \code{\link{mse}} 22 | #' @name summary.elo 23 | NULL 24 | #> NULL 25 | 26 | #' @rdname summary.elo 27 | #' @export 28 | summary.elo.run <- function(object, ...) 29 | { 30 | object$favored <- favored(object) 31 | object$mse <- mse(object) 32 | object$auc <- auc.elo.run(object) 33 | class(object) <- c("summary.elo.run", class(object)) 34 | object 35 | } 36 | 37 | #' @export 38 | print.summary.elo.run <- function(x, ...) 39 | { 40 | NextMethod() 41 | cat("Mean Square Error: ", round(x$mse, 4), "\n", 42 | "AUC: ", round(x$auc, 4), "\n", 43 | "Favored Teams vs. Actual Wins: \n", 44 | sep = "") 45 | print(x$favored) 46 | 47 | invisible(x) 48 | } 49 | 50 | #' @rdname summary.elo 51 | #' @export 52 | summary.elo.glm <- function(object, ...) 53 | { 54 | out <- NextMethod() 55 | out$favored <- favored(object, ...) 56 | out$mse <- mse(object, ...) 57 | out$auc <- if(object$outcome == "mov") NA_real_ else auc.elo.glm(object, ...) 58 | class(out) <- c("summary.elo.glm", class(out)) 59 | out 60 | } 61 | 62 | #' @export 63 | print.summary.elo.glm <- function(x, ...) 64 | { 65 | NextMethod() 66 | cat("Mean Square Error: ", round(x$mse, 4), "\n", 67 | "AUC: ", round(x$auc, 4), "\n", 68 | "Favored Teams vs. Actual Wins: \n", 69 | sep = "") 70 | print(x$favored) 71 | 72 | invisible(x) 73 | } 74 | 75 | #' @rdname summary.elo 76 | #' @export 77 | summary.elo.markovchain <- function(object, ...) 78 | { 79 | object$favored <- favored(object, ...) 80 | object$mse <- mse(object, ...) 81 | object$auc <- if(object$outcome == "mov") NA_real_ else auc.elo.markovchain(object, ...) 82 | class(object) <- c("summary.elo.markovchain", class(object)) 83 | object 84 | } 85 | 86 | #' @export 87 | print.summary.elo.markovchain <- print.summary.elo.glm 88 | 89 | #' @rdname summary.elo 90 | #' @export 91 | summary.elo.colley <- function(object, ...) 92 | { 93 | object$favored <- favored(object, ...) 94 | object$mse <- mse(object, ...) 95 | object$auc <- if(object$outcome == "mov") NA_real_ else auc.elo.colley(object, ...) 96 | class(object) <- c("summary.elo.colley", class(object)) 97 | object 98 | } 99 | 100 | #' @export 101 | print.summary.elo.colley <- print.summary.elo.glm 102 | 103 | #' @rdname summary.elo 104 | #' @export 105 | summary.elo.winpct <- function(object, ...) 106 | { 107 | object$favored <- favored(object, ...) 108 | object$mse <- mse(object, ...) 109 | object$auc <- if(object$outcome == "mov") NA_real_ else auc.elo.winpct(object, ...) 110 | class(object) <- c("summary.elo.winpct", class(object)) 111 | object 112 | } 113 | 114 | #' @export 115 | print.summary.elo.winpct <- print.summary.elo.glm 116 | -------------------------------------------------------------------------------- /src/elo.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | using namespace Rcpp; 3 | 4 | double eloProb(double eloA, double eloB) 5 | { 6 | return 1/(1 + exp(log(10.0)*(eloB - eloA)/400.0)); 7 | } 8 | 9 | double eloUpdate(double prob, double winsA, double k) 10 | { 11 | return k*(winsA - prob); 12 | } 13 | 14 | NumericVector eloRegress(NumericVector eloA, NumericVector to, double by, LogicalVector idx) 15 | { 16 | for(int i = 0; i < eloA.size(); i++) 17 | { 18 | if(idx[i]) 19 | { 20 | eloA[i] = eloA[i] + by*(to[i] - eloA[i]); 21 | } 22 | } 23 | 24 | return eloA; 25 | } 26 | 27 | // [[Rcpp::export]] 28 | List eloRun(NumericMatrix teamA, NumericMatrix teamB, NumericVector weightsA, NumericVector weightsB, 29 | NumericVector winsA, NumericMatrix k, NumericVector adjTeamA, NumericVector adjTeamB, 30 | LogicalVector regress, NumericVector to, double by, bool regressUnused, 31 | NumericVector group, NumericVector initialElos, int flag) 32 | { 33 | // this function uses 0-based indexing, since the incoming vectors used -1L 34 | int nTeams = initialElos.size(); 35 | int ncolA = teamA.ncol(); 36 | int ncolB = teamB.ncol(); 37 | int nBoth = ncolA + ncolB; 38 | int nGames = winsA.size(); 39 | int nRegress = sum(regress); 40 | 41 | NumericVector currElo(nTeams); 42 | LogicalVector usedYet(nTeams); 43 | currElo = clone(initialElos); 44 | NumericVector groupElo(nTeams); 45 | groupElo = clone(initialElos); 46 | 47 | NumericMatrix out(nGames, 4 + 2*nBoth); 48 | NumericMatrix regOut(nRegress, nTeams); 49 | 50 | int regRow = 0; 51 | for(int i = 0; i < nGames; i++) 52 | { 53 | NumericVector e1(ncolA); 54 | NumericVector e2(ncolB); 55 | NumericVector curr1(ncolA); 56 | NumericVector curr2(ncolB); 57 | 58 | // get initial Elos for team A 59 | for(int j = 0; j < ncolA; j++) 60 | { 61 | double tmA = teamA(i, j); 62 | e1[j] = groupElo[tmA]; 63 | curr1[j] = currElo[tmA]; 64 | usedYet[tmA] = true; 65 | out(i, j) = tmA + 1; 66 | } 67 | 68 | // get initial Elos for team B 69 | for(int l = 0; l < ncolB; l++) 70 | { 71 | if(flag == 2) 72 | { 73 | e2[l] = teamB(i, l); 74 | curr2[l] = teamB(i, l); 75 | out(i, ncolA + l) = 0; 76 | } else 77 | { 78 | double tmB = teamB(i, l); 79 | e2[l] = groupElo[tmB]; 80 | curr2[l] = currElo[tmB]; 81 | usedYet[tmB] = true; 82 | out(i, ncolA + l) = tmB + 1; 83 | } 84 | } 85 | 86 | // calculate and store the update 87 | double prb = eloProb(sum(e1) + adjTeamA[i], sum(e2) + adjTeamB[i]); 88 | double updt1 = eloUpdate(prb, winsA[i], k(i, 0)); 89 | double updt2 = eloUpdate(prb, winsA[i], k(i, 1)) * -1.0; 90 | 91 | out(i, nBoth) = prb; 92 | out(i, nBoth + 1) = winsA[i]; 93 | out(i, nBoth + 2) = updt1; 94 | out(i, nBoth + 3) = updt2; 95 | 96 | // store new Elos for team A 97 | for(int j = 0; j < ncolA; j++) 98 | { 99 | double tmp = curr1[j] + updt1 * weightsA[j]; 100 | out(i, nBoth + 4 + j) = tmp; 101 | currElo[teamA(i, j)] = tmp; 102 | } 103 | 104 | // store new Elos for team B 105 | for(int l = 0; l < ncolB; l++) 106 | { 107 | if(flag == 2) 108 | { 109 | out(i, nBoth + 4 + ncolA + l) = curr2[l]; 110 | } else 111 | { 112 | double tmp = curr2[l] + updt2 * weightsB[l]; 113 | out(i, nBoth + 4 + ncolA + l) = tmp; 114 | currElo[teamB(i, l)] = tmp; 115 | } 116 | } 117 | 118 | // This part is fine 119 | if(regress[i]) 120 | { 121 | currElo = eloRegress(currElo, to, by, usedYet); 122 | regOut(regRow, _) = currElo; 123 | regRow++; 124 | if(!regressUnused) 125 | { 126 | for(int l = 0; l < nTeams; l++) 127 | { 128 | usedYet[l] = false; 129 | } 130 | } 131 | } 132 | 133 | if(group[i]) 134 | { 135 | groupElo = currElo; 136 | } 137 | } 138 | 139 | return List::create(out, regOut); 140 | } 141 | 142 | -------------------------------------------------------------------------------- /tests/testthat/test_elo_functions.R: -------------------------------------------------------------------------------- 1 | context("Testing the other elo functions") 2 | 3 | ########################################################################################################### 4 | #### Do some simple checks 5 | ########################################################################################################### 6 | 7 | test_that("elo.prob works", { 8 | expect_equal(elo.prob(1500, 1500), 0.5) 9 | expect_equal( 10 | elo.prob(dat$dummy.A, dat$dummy.B), 11 | elo.prob(~ dummy.A + dummy.B, data = dat) 12 | ) 13 | expect_equal( 14 | elo.prob(dat$dummy.A, dat$dummy.B, adjust.A = 10, adjust.B = 20), 15 | elo.prob(~ adjust(dummy.A, 10) + adjust(dummy.B, 20), data = dat) 16 | ) 17 | expect_equal( 18 | elo.prob(dat$dummy.A, dat$dummy.B, adjust.A = 10, adjust.B = 20), 19 | elo.prob(dat$dummy.A + 10, dat$dummy.B + 20) 20 | ) 21 | expect_equal( 22 | elo.prob(~ dummy.A + dummy.B, data = dat), 23 | elo.prob(wins.A ~ dummy.A + dummy.B + k(k.column), data = dat) 24 | ) 25 | 26 | #### with teams #### 27 | 28 | expect_equal( 29 | elo.prob(dat$team.A, dat$team.B, elos = init), 30 | elo.prob(~ team.A + team.B, data = dat, elos = init) 31 | ) 32 | expect_equal( 33 | elo.prob(c(1600, 1600, 1400), c(1500, 1400, 1500)), 34 | elo.prob(~ team.A + team.B, data = dat, elos = init) 35 | ) 36 | expect_equal( 37 | elo.prob(c(1600, 1600, 1400), c(1500, 1500, 1500)), 38 | elo.prob(~ team.A + dummy.B, data = dat, elos = init) 39 | ) 40 | expect_equal( 41 | elo.prob(c(1600, 1600, 1400), c(1500, 1500, 1500), adjust.A = 20), 42 | elo.prob(~ adjust(team.A, 20) + dummy.B, data = dat, elos = init) 43 | ) 44 | expect_error( 45 | elo.prob(~ team.A + team.B, na.action = na.pass, 46 | data = data.frame(team.A = c("A", NA), team.B = 1500, stringsAsFactors = FALSE)) 47 | ) 48 | }) 49 | 50 | test_that("elo.update works", { 51 | expect_equal(elo.update(1, 1500, 1500, k = 20), 10) 52 | expect_equal( 53 | elo.update(dat$wins.A, dat$dummy.A, dat$dummy.B, k = dat$k.column), 54 | elo.update(wins.A ~ dummy.A + dummy.B + k(k.column), data = dat) 55 | ) 56 | expect_equal( 57 | elo.update(dat$wins.A, dat$dummy.A, dat$dummy.B, k = dat$k.column, adjust.A = 10, adjust.B = 20), 58 | elo.update(wins.A ~ adjust(dummy.A, 10) + adjust(dummy.B, 20) + k(k.column), data = dat) 59 | ) 60 | expect_equal( 61 | elo.update(dat$wins.A, dat$dummy.A, dat$dummy.B, k = dat$k.column, adjust.A = 10, adjust.B = 20), 62 | elo.update(dat$wins.A, dat$dummy.A + 10, dat$dummy.B + 20, k = dat$k.column) 63 | ) 64 | expect_equal( 65 | elo.update(wins.A ~ dummy.A + dummy.B, data = dat, k = 20), 66 | elo.update(wins.A ~ dummy.A + dummy.B + k(k.column), data = dat) 67 | ) 68 | }) 69 | 70 | test_that("elo.calc works", { 71 | expect_equal(elo.calc(1, 1500, 1500, k = 20), data.frame(elo.A = 1510, elo.B = 1490)) 72 | expect_equal( 73 | elo.calc(dat$wins.A, dat$dummy.A, dat$dummy.B, k = dat$k.column), 74 | elo.calc(wins.A ~ dummy.A + dummy.B + k(k.column), data = dat) 75 | ) 76 | expect_equal( 77 | elo.calc(dat$wins.A, dat$dummy.A, dat$dummy.B, k = dat$k.column, adjust.A = 10, adjust.B = 20), 78 | elo.calc(wins.A ~ adjust(dummy.A, 10) + adjust(dummy.B, 20) + k(k.column), data = dat) 79 | ) 80 | expect_equal( 81 | elo.calc(wins.A ~ dummy.A + dummy.B, data = dat, k = 20), 82 | elo.calc(wins.A ~ dummy.A + dummy.B + k(k.column), data = dat) 83 | ) 84 | }) 85 | 86 | test_that("k works with two columns (#45)", { 87 | expect_equal( 88 | elo.calc(wins.A ~ dummy.A + dummy.B + k(k.column, 2*k.column), data = dat), 89 | data.frame(elo.A = c(1510, 1510, 1490), elo.B = c(1480, 1480, 1520)) 90 | ) 91 | expect_equal( 92 | elo.calc(dat$wins.A, dat$dummy.A, dat$dummy.B, k = cbind(dat$k.column, 2*dat$k.column)), 93 | elo.calc(wins.A ~ dummy.A + dummy.B + k(k.column, 2*k.column), data = dat) 94 | ) 95 | expect_equal( 96 | elo.calc(dat$wins.A, dat$dummy.A, dat$dummy.B, k = cbind(dat$k.column, 2*dat$k.column), adjust.A = 10, adjust.B = 20), 97 | elo.calc(wins.A ~ adjust(dummy.A, 10) + adjust(dummy.B, 20) + k(k.column, 2*k.column), data = dat) 98 | ) 99 | }) 100 | 101 | 102 | 103 | -------------------------------------------------------------------------------- /R/elo.winpct.R: -------------------------------------------------------------------------------- 1 | #' Compute a (usually logistic) regression based on win percentage for a series of matches. 2 | #' 3 | #' @inheritParams elo.glm 4 | #' @param weights A vector of weights. Note that these are used in calculating wins and losses but 5 | #' not in the regression. 6 | #' @details 7 | #' Win percentages are first calculated. Anything passed to \code{\link{adjust}()} in 8 | #' \code{formula} is also put in the data.frame. A \code{\link{glm}} model is then 9 | #' run to predict wins or margin of victory. 10 | #' 11 | #' With this setup, the intercept represents the home-field advantage. Neutral fields can be indicated 12 | #' using the \code{\link{neutral}()} function, which sets the intercept to 0. 13 | #' @examples 14 | #' elo.winpct(score(points.Home, points.Visitor) ~ team.Home + team.Visitor, data = tournament, 15 | #' subset = points.Home != points.Visitor) 16 | #' 17 | #' elo.winpct(mov(points.Home, points.Visitor) ~ team.Home + team.Visitor, data = tournament, 18 | #' family = "gaussian") 19 | #' @seealso \code{\link[stats]{glm}}, \code{\link{summary.elo.winpct}}, \code{\link{score}}, 20 | #' \code{\link{mov}}, \code{\link{elo.model.frame}} 21 | #' @name elo.winpct 22 | NULL 23 | #> NULL 24 | 25 | #' @rdname elo.winpct 26 | #' @export 27 | elo.winpct <- function(formula, data, family = "binomial", weights, na.action, subset, ..., running = FALSE, skip = 0) 28 | { 29 | Call <- match.call() 30 | Call[[1L]] <- quote(elo::elo.model.frame) 31 | Call$required.vars <- c("wins", "elos", "group", "neutral", "weights") 32 | mf <- eval(Call, parent.frame()) 33 | if(nrow(mf) == 0) stop("No (non-missing) observations") 34 | Terms <- stats::terms(mf) 35 | 36 | dat <- check_elo_winpct_vars(mf) 37 | all.teams <- attr(dat, "teams") 38 | grp <- mf$group 39 | 40 | out <- do.call(eloWinPct, dat) 41 | vec <- stats::setNames(out[[1]], all.teams) 42 | 43 | difference <- mean_vec_subset_matrix(vec, dat$teamA+1) - mean_vec_subset_matrix(vec, dat$teamB+1) 44 | wl.dat <- data.frame(wins.A = mf$wins.A, home.field = mf$home.field, difference = difference) 45 | if(!all(mf$adj.A == 0)) wl.dat$adj.A <- mf$adj.A 46 | if(!all(mf$adj.B == 0)) wl.dat$adj.B <- mf$adj.B 47 | wl.glm <- stats::glm(wins.A ~ . - 1, family = family, data = wl.dat) 48 | out <- list( 49 | fit = wl.glm, 50 | weights = mf$weights, 51 | win.pct = stats::setNames(out[[1]], all.teams), 52 | n.games = out[[2]], 53 | y = wl.glm$y, 54 | fitted.values = wl.glm$fitted.values, 55 | teams = all.teams, 56 | group = grp, 57 | elo.terms = Terms, 58 | na.action = stats::na.action(mf), 59 | outcome = attr(mf, "outcome") 60 | ) 61 | 62 | if(running) 63 | { 64 | ftd <- rep(0, times = nrow(wl.dat)) 65 | grp2 <- group_to_int(grp, skip) 66 | y <- dat$winsA 67 | adj <- cbind(mf$home.field, mf$adj.A, mf$adj.B) 68 | 69 | for(i in setdiff(seq_len(max(grp2)), seq_len(skip))) 70 | { 71 | if(i == 0) next 72 | sbst <- grp2 %in% 0:(i-1) 73 | dat.tmp <- dat 74 | dat.tmp[1:2] <- lapply(dat.tmp[1:2], `[`, sbst) 75 | dat.tmp$teamA <- dat.tmp$teamA[sbst, , drop = FALSE] 76 | dat.tmp$teamB <- dat.tmp$teamB[sbst, , drop = FALSE] 77 | 78 | wl <- do.call(eloWinPct, dat.tmp) 79 | vec <- stats::setNames(wl[[1]], all.teams) 80 | 81 | difference <- mean_vec_subset_matrix(vec, dat$teamA+1) - mean_vec_subset_matrix(vec, dat$teamB+1) 82 | 83 | # tmpfit <- stats::glm(dat$winsA ~ difference, subset = sbst, family = "binomial") 84 | # ftd[grp2 == i] <- predict(tmpfit, newdata = data.frame(difference = difference[grp2 == i]), type = "link") 85 | 86 | coeff <- stats::glm.fit(cbind(difference, adj)[sbst, , drop=FALSE], 87 | dat.tmp$winsA, family = wl.glm$family, control = wl.glm$control)$coefficients 88 | ftd[grp2 == i] <- apply(cbind(difference, adj)[grp2 == i, , drop=FALSE], 1, mult_na_coef, coeff = coeff) 89 | } 90 | out$running.values <- wl.glm$family$linkinv(ftd) 91 | attr(out$running.values, "group") <- grp2 92 | } 93 | 94 | structure(out, class = c(if(running) "elo.running", "elo.winpct")) 95 | } 96 | 97 | #' @export 98 | print.elo.winpct <- function(x, ...) 99 | { 100 | cat("\nAn object of class 'elo.winpct', containing information on ", length(x$teams), 101 | " teams and ", sum(x$n.games)/2, " matches.\n\n", sep = "") 102 | invisible(x) 103 | } 104 | -------------------------------------------------------------------------------- /tests/testthat/test_auxiliary.R: -------------------------------------------------------------------------------- 1 | context("Testing the auxiliary functions") 2 | 3 | ########################################################################################################### 4 | #### Do some simple checks 5 | ########################################################################################################### 6 | 7 | results <- elo.run(wins.A ~ adjust(team.A, 10) + team.B, data = rbind(dat, dat), k = 20) 8 | results.na <- elo.run(replace(wins.A, 1, NA) ~ adjust(team.A, 10) + team.B, 9 | data = rbind(dat, dat), k = 20, na.action = na.exclude) 10 | 11 | results.glm <- elo.glm(wins.A ~ team.A + team.B, data = rbind(dat, dat)) 12 | results.glm.na <- elo.glm(replace(wins.A, 1, NA) ~ team.A + team.B, data = rbind(dat, dat), na.action = na.exclude) 13 | 14 | test_that("fitted and residuals works with NAs (#39)", { 15 | expect_true(is.na(fitted(results.glm.na)[1])) 16 | expect_true(is.na(fitted(results.na)[1])) 17 | expect_true(is.na(residuals(results.glm.na)[1])) 18 | expect_true(is.na(residuals(results.na)[1])) 19 | }) 20 | 21 | test_that("auc.elo.run works", { 22 | expect_equal( 23 | as.numeric(pROC::auc(results$elos[, 4], results$elos[, 3])), 24 | auc(results) 25 | ) 26 | }) 27 | 28 | test_that("auc.elo.glm works (#37)", { 29 | expect_equal( 30 | as.numeric(pROC::auc(results.glm$y, results.glm$fitted.values)), 31 | auc(results.glm) 32 | ) 33 | 34 | expect_false(is.na(auc(results.glm.na))) 35 | }) 36 | 37 | test_that("favored.elo.run works", { 38 | results <- elo.run(wins.A ~ adjust(team.A, 10) + team.B, data = rbind(dat, dat), k = 20) 39 | 40 | expect_equal( 41 | favored(results), 42 | as.table(matrix(c(1, 0, 1, 4, 0, 0), nrow = 3, 43 | dimnames = list(Favored = c("TRUE", "(tie)", "FALSE"), Actual = c("0", "1")))) 44 | ) 45 | }) 46 | 47 | test_that("favored.elo.glm works (#38)", { 48 | results <- elo.glm(wins.A ~ team.A + team.B, data = rbind(dat, dat)) 49 | 50 | expect_equal( 51 | favored(results), 52 | as.table(matrix(c(0, 0, 2, 4, 0, 0), nrow = 3, 53 | dimnames = list(Favored = c("TRUE", "(tie)", "FALSE"), Actual = c("0", "1")))) 54 | ) 55 | }) 56 | 57 | test_that("rank.teams works", { 58 | er <- elo.run(score(points.Home, points.Visitor) ~ adjust(team.Home, 30) + team.Visitor, data = tournament, k = 20, 59 | subset = points.Home != points.Visitor) 60 | em <- elo.markovchain(score(points.Home, points.Visitor) ~ team.Home + team.Visitor, data = tournament, k = 0.7, 61 | subset = points.Home != points.Visitor) 62 | eg <- elo.glm(score(points.Home, points.Visitor) ~ team.Home + team.Visitor, data = tournament, 63 | subset = points.Home != points.Visitor) 64 | ew <- elo.winpct(score(points.Home, points.Visitor) ~ team.Home + team.Visitor, data = tournament, 65 | subset = points.Home != points.Visitor) 66 | 67 | 68 | expect_equal(unname(rank.teams(er)), c(1, 7, 3, 8, 5, 2, 4, 6)) 69 | expect_equal(names(rank.teams(er)), er$teams) 70 | 71 | expect_equal(unname(rank.teams(em)), c(1, 7, 3, 8, 4, 2, 6, 5)) 72 | expect_equal(names(rank.teams(em)), em$teams) 73 | 74 | expect_equal(unname(rank.teams(eg)), c(1, 7, 3, 8, 5, 2, 4, 6)) 75 | expect_equal(names(rank.teams(eg)), eg$teams) 76 | 77 | expect_equal(unname(rank.teams(ew)), c(1, 7, 4, 8, 5, 2, 3, 6)) 78 | expect_equal(names(rank.teams(ew)), ew$teams) 79 | }) 80 | 81 | 82 | 83 | 84 | 85 | 86 | 87 | 88 | test_that("#56: running predictions for new teams", { 89 | d <- data.frame( 90 | team1 = c("A", "B", "A", "A", "B", "C", "C", "C", "B"), 91 | team2 = c("B", "A", "B", "B", "A", "A", "B", "A", "C"), 92 | win1 = c(1, 1, 0, 0, 1, 1, 1, 0, 1), 93 | grp = c(1:5, 7, 7, 7, 8) 94 | ) 95 | eg <- elo.glm(win1 ~ team1 + team2 + group(grp), data = d, running = TRUE, skip = 4) 96 | expect_equal(sum(is.na(fitted(eg, running = TRUE))), 3) 97 | 98 | ec <- elo.colley(win1 ~ team1 + team2 + group(grp), data = d, running = TRUE, skip = 4) 99 | expect_equal(sum(is.na(fitted(ec, running = TRUE))), 3) 100 | 101 | em <- elo.markovchain(win1 ~ team1 + team2 + group(grp), data = d, running = TRUE, skip = 4, k = 0.9) 102 | expect_equal(sum(is.na(fitted(em, running = TRUE))), 3) 103 | 104 | ew <- elo.winpct(win1 ~ team1 + team2 + group(grp), data = d, running = TRUE, skip = 4) 105 | expect_equal(sum(is.na(fitted(ew, running = TRUE))), 3) 106 | 107 | }) 108 | -------------------------------------------------------------------------------- /R/elo.glm.R: -------------------------------------------------------------------------------- 1 | #' Compute a (usually logistic) regression model for a series of matches. 2 | #' 3 | #' @inheritParams elo.calc 4 | #' @param family Argument passed to \code{\link[stats]{glm}}. 5 | #' @param weights Argument passed to \code{\link[stats]{glm}}. 6 | #' @param ... Argument passed to \code{\link[stats]{glm}}. 7 | #' @param running Logical, denoting whether to calculate "running" projected probabilities. If true, a model is fit for 8 | #' group 1 on its own to predict group 2, then groups 1 and 2 to predict 3, then groups 1 through 3 to predict 4, etc. 9 | #' Groups are determined in \code{formula}. Omitting a group term re-runs a glm model to predict each 10 | #' observation (a potentially time-consuming operation!) 11 | #' @param skip Integer, denoting how many groups to skip before fitting the running models. This is helpful if 12 | #' groups are small, where glm would have trouble converging for the first few groups. The predicted values are then 13 | #' set to 0.5 for the skipped groups. 14 | #' @return An object of class \code{c("elo.glm", "glm")}. If \code{running==TRUE}, the class \code{"elo.glm.running"} 15 | #' is prepended. 16 | #' @details 17 | #' The formula syntax is the same as other \code{elo} functions. A data.frame 18 | #' of indicator variables is built, where an entry is 1 if a team is home, 0 if 19 | #' a team didn't play, and -1 if a team is a visitor. Anything passed to \code{\link{adjust}()} in 20 | #' \code{formula} is also put in the data.frame. A \code{\link{glm}} model is then 21 | #' run to predict wins or margin of victory. 22 | #' 23 | #' With this setup, the intercept represents the home-field advantage. Neutral fields can be indicated 24 | #' using the \code{\link{neutral}()} function, which sets the intercept to 0. 25 | #' 26 | #' Note that any weights specified in \code{players()} will be ignored. 27 | #' 28 | #' This is essentially the Bradley-Terry model. 29 | #' @references https://en.wikipedia.org/wiki/Bradley%E2%80%93Terry_model 30 | #' @examples 31 | #' data(tournament) 32 | #' elo.glm(score(points.Home, points.Visitor) ~ team.Home + team.Visitor, data = tournament, 33 | #' subset = points.Home != points.Visitor) 34 | #' elo.glm(mov(points.Home, points.Visitor) ~ team.Home + team.Visitor, data = tournament, 35 | #' family = "gaussian") 36 | #' @seealso \code{\link[stats]{glm}}, \code{\link{summary.elo.glm}}, \code{\link{score}}, 37 | #' \code{\link{mov}}, \code{\link{elo.model.frame}} 38 | #' @name elo.glm 39 | NULL 40 | #> NULL 41 | 42 | #' @rdname elo.glm 43 | #' @export 44 | elo.glm <- function(formula, data, family = "binomial", weights, na.action, subset, ..., running = FALSE, skip = 0) 45 | { 46 | Call <- match.call() 47 | Call <- Call[c(1, match(c("formula", "data", "weights", "subset", "na.action"), names(Call), nomatch = 0))] 48 | Call[[1L]] <- quote(elo::elo.model.frame) 49 | Call$required.vars <- c("wins", "elos", "group", "neutral", "weights") 50 | mf <- eval(Call, parent.frame()) 51 | if(nrow(mf) == 0) stop("No (non-missing) observations") 52 | Terms <- stats::terms(mf) 53 | 54 | dat <- mf_to_wide(mf) 55 | all.teams <- attr(dat, "all.teams") 56 | 57 | # find spanning set 58 | QR <- qr(dat) 59 | dat.qr <- dat[QR$pivot[seq_len(QR$rank)]] 60 | 61 | dat.qr$wins.A <- mf$wins.A 62 | grp <- mf$group 63 | 64 | wts <- mf$weights 65 | out <- stats::glm(wins.A ~ . - 1, data = dat.qr, family = family, na.action = stats::na.pass, subset = NULL, weights = wts, ...) 66 | out$teams <- all.teams 67 | out$group <- grp 68 | out$elo.terms <- Terms 69 | out$na.action <- stats::na.action(mf) 70 | out$outcome <- attr(mf, "outcome") 71 | 72 | if(running) 73 | { 74 | dat.mat <- as.matrix(dat) 75 | y <- mf$wins.A 76 | 77 | ftd <- rep(0, times = nrow(dat)) 78 | grp2 <- group_to_int(grp, skip) 79 | 80 | for(i in setdiff(seq_len(max(grp2)), seq_len(skip))) 81 | { 82 | if(i == 0) next 83 | sbst <- grp2 %in% 0:(i-1) 84 | 85 | # tmpfit <- stats::glm(wins.A ~ . - 1, data = dat, subset = sbst, weights = wts, family = family) 86 | # ftd[grp2 == i] <- predict(tmpfit, newdata = dat[grp2 == i, ], type = "link") 87 | 88 | d <- dat.mat[sbst, , drop = FALSE] 89 | coeff <- stats::glm.fit(d, y[sbst], wts[sbst], family = out$family, 90 | control = out$control)$coefficients 91 | valid <- colSums(d != 0) > 0 92 | ftd[grp2 == i] <- apply(dat.mat[grp2 == i, , drop = FALSE], 1, mult_valid_coef, coeff = coeff, valid = valid) 93 | } 94 | out$running.values <- out$family$linkinv(ftd) 95 | attr(out$running.values, "group") <- grp2 96 | } 97 | 98 | structure(out, class = c(if(running) "elo.running", "elo.glm", class(out))) 99 | } 100 | -------------------------------------------------------------------------------- /man/formula.specials.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/elo.players.R, R/formula.specials.R 3 | \name{players} 4 | \alias{players} 5 | \alias{multiteam} 6 | \alias{formula.specials} 7 | \alias{k} 8 | \alias{adjust} 9 | \alias{regress} 10 | \alias{group} 11 | \alias{neutral} 12 | \title{Details on \code{elo} formulas and the specials therein} 13 | \usage{ 14 | players(..., weights = NULL) 15 | 16 | multiteam(...) 17 | 18 | k(x, y = NULL) 19 | 20 | adjust(x, adjustment) 21 | 22 | regress(x, to, by, regress.unused = TRUE) 23 | 24 | group(x) 25 | 26 | neutral(x) 27 | } 28 | \arguments{ 29 | \item{...}{Vectors to be coerced to character, which comprise of the players of a team.} 30 | 31 | \item{weights}{A vector giving the weights of Elo updates for the players in \code{...}. Ignored for 32 | \code{\link{elo.glm}}.} 33 | 34 | \item{x, y}{A vector.} 35 | 36 | \item{adjustment}{A single value or a vector of the same length as \code{x}: how much to adjust the Elos in \code{x}.} 37 | 38 | \item{to}{Numeric: what Elo to regress to. Can be a single value or named vector the same length 39 | as the number of teams.} 40 | 41 | \item{by}{Numeric: by how much should Elos be regressed toward \code{to}.} 42 | 43 | \item{regress.unused}{Logical: whether to continue regressing teams which have stopped playing.} 44 | } 45 | \description{ 46 | Details on \code{elo} functions and the special functions allowed in them to change functions' behaviors. 47 | } 48 | \details{ 49 | In the functions in this package, \code{formula} is usually of the form \code{wins.A ~ elo.A + elo.B}, 50 | where \code{elo.A} and \code{elo.B} are vectors of Elos, and \code{wins.A} is between 0 and 1, 51 | denoting whether team A (Elo A) won or lost (or something between). \code{elo.prob} also allows 52 | \code{elo.A} and \code{elo.B} to be character or factors, denoting which team(s) played. \code{elo.run} 53 | requires \code{elo.A} to be a vector of teams or a players matrix from \code{players()} 54 | (sometimes denoted by \code{"team.A"}), but \code{elo.B} can be either a vector of teams or 55 | players matrix (\code{"team.B"}) or else a numeric column (denoting a fixed-Elo opponent). 56 | \code{elo.glm} requires both to be a vector of teams or players matrix. \code{\link{elo.markovchain}} 57 | requires both to be a vector of teams. 58 | 59 | \code{formula} accepts six special functions in it: 60 | 61 | \code{k()} allows for complicated Elo updates. For 62 | constant Elo updates, use the \code{k = } argument instead of this special function. 63 | Note that \code{\link{elo.markovchain}} uses this function (or argument) as a convenient 64 | way of specifying transition probabilities. \code{\link{elo.colley}} uses this to indicate 65 | the fraction of a win to be assigned to the winning team. 66 | 67 | \code{adjust()} allows for Elos to be adjusted for, e.g., home-field advantage. The second argument 68 | to this function can be a scalar or vector of appropriate length. This can also be used in 69 | \code{\link{elo.glm}} and \code{\link{elo.markovchain}} as an adjuster to the logistic regressions. 70 | 71 | \code{regress()} can be used to regress Elos back to a fixed value 72 | after certain matches. Giving a logical vector identifies these matches after which to 73 | regress back to the mean. Giving any other kind of vector regresses after the appropriate 74 | groupings (see, e.g., \code{\link{duplicated}(..., fromLast = TRUE)}). The other three arguments determine 75 | what Elo to regress to (\code{to = }), by how much to regress toward that value 76 | (\code{by = }), and whether to continue regressing teams which have stopped playing (\code{regress.unused}, 77 | default = \code{TRUE}). 78 | 79 | \code{group()} is used to group matches (by, e.g., week). For \code{\link{elo.run}}, Elos are not updated until 80 | the group changes. It is also fed to \code{\link{as.matrix.elo.run}}, giving the number of rows to return. 81 | to produce only certain rows of matrix output. It also determines how many models to run (and on what data) 82 | for \code{\link{elo.glm}} and \code{\link{elo.markovchain}} when \code{running=TRUE}. 83 | 84 | \code{neutral()} is used in \code{\link{elo.glm}} and \code{\link{elo.markovchain}} to determine the intercept. 85 | In short, the intercept is \code{1 - neutral()}, denoting home-field advantage. Therefore, the column 86 | passed should be 0 (denoting home-field advantange) or 1 (denoting a neutral game). If omitted, all matches 87 | are assumed to have home field advantage. 88 | 89 | \code{players()} is used for multiple players on a team contributing to an overall Elo. The Elo updates 90 | are then assigned based on the specified weights. The weights are ignored in \code{\link{elo.glm}}. 91 | 92 | \code{multiteam()} is used for matchups consisting of multiple teams and is only valid in \code{\link{elo.run.multiteam}}. 93 | } 94 | -------------------------------------------------------------------------------- /R/elo.run.R: -------------------------------------------------------------------------------- 1 | #' Calculate running Elos for a series of matches. 2 | #' 3 | #' @inheritParams elo.calc 4 | #' @param initial.elos An optional named vector containing initial Elo ratings for all teams in \code{formula}. 5 | #' If a single (unnamed) value is supplied, that value is applied to all teams. \code{NULL} (the default) 6 | #' sets all Elos to 1500. 7 | #' @param ... Other arguments (not used at this time). 8 | #' @param prob.fun A function with at least 4 arguments: elo.A, elo.B, adjust.A, and adjust.B. It should return a predicted probability 9 | #' that team A wins. The values passed in will be scalars, and a scalar is expected as output. 10 | #' @param update.fun A function with at least 6 arguments: the same as \code{\link{elo.update.default}}. The function takes 11 | #' in the Elos, the win indicator, k, and any adjustments, and returns a value by which to update the Elos. The values passed in 12 | #' will be scalars, and a scalar is expected as output. 13 | #' @param verbose Should a message be issued when R is used (over C++)? 14 | #' @details 15 | #' \code{elo.run} is run two different ways: the first (default) uses C++ and may be up to 50 times faster, 16 | #' while the second (when \code{prob.fun} or \code{update.fun} are specified) uses R but also supports custom update functions. 17 | #' Prefer the first unless you really need a custom update function. 18 | #' @return An object of class \code{"elo.run"} or class \code{"elo.run.regressed"}. 19 | #' @examples 20 | #' data(tournament) 21 | #' elo.run(score(points.Home, points.Visitor) ~ team.Home + team.Visitor, 22 | #' data = tournament, k = 20) 23 | #' 24 | #' # Create non-constant 'k' 25 | #' elo.run(score(points.Home, points.Visitor) ~ team.Home + team.Visitor + 26 | #' k(20*log(abs(points.Home - points.Visitor) + 1)), data = tournament) 27 | #' 28 | #' # Adjust Elo for, e.g., home-field advantage 29 | #' elo.run(score(points.Home, points.Visitor) ~ adjust(team.Home, 30) + team.Visitor, 30 | #' data = tournament, k = 20) 31 | #' 32 | #' tournament$home.field <- 30 33 | #' elo.run(score(points.Home, points.Visitor) ~ adjust(team.Home, home.field) + team.Visitor, 34 | #' data = tournament, k = 20) 35 | #' 36 | #' # Regress the Elos back toward 1500 at the end of the half-season 37 | #' elo.run(score(points.Home, points.Visitor) ~ adjust(team.Home, 30) + 38 | #' team.Visitor + regress(half, 1500, 0.2), data = tournament, k = 20) 39 | #' 40 | #' @seealso \code{\link{score}}, \link{elo.run.helpers}{elo.run helpers}, \code{\link{elo.calc}}, 41 | #' \code{\link{elo.update}}, \code{\link{elo.prob}}, \code{\link{elo.model.frame}}. 42 | #' @name elo.run 43 | NULL 44 | #> NULL 45 | 46 | #' @rdname elo.run 47 | #' @export 48 | elo.run <- function(formula, data, na.action, subset, k = NULL, initial.elos = NULL, ..., prob.fun = elo.prob, update.fun = elo.update, verbose = TRUE) 49 | { 50 | Call <- match.call() 51 | Call <- Call[c(1, match(c("formula", "data", "subset", "na.action", "k"), names(Call), nomatch = 0))] 52 | Call[[1L]] <- quote(elo::elo.model.frame) 53 | Call$required.vars <- c("wins", "elos", "k", "group", "regress") 54 | Call$ncol.k <- 2 55 | mf <- eval(Call, parent.frame()) 56 | if(nrow(mf) == 0) stop("No (non-missing) observations") 57 | Terms <- stats::terms(mf) 58 | 59 | checked <- check_elo_run_vars(mf, initial.elos) 60 | if(missing(prob.fun) && missing(update.fun)) 61 | { 62 | out <- do.call(eloRun, checked) 63 | } else 64 | { 65 | if(verbose) message("Using R instead of C++") 66 | checked$prob.fun <- match.fun(prob.fun) 67 | checked$update.fun <- match.fun(update.fun) 68 | out <- do.call(eloRun2, checked) 69 | } 70 | any.regr <- any(checked$regress) 71 | 72 | structure(list( 73 | elos = out[[1]], 74 | n.matches = nrow(out[[1]]), 75 | n.players = c(ncol(checked$teamA), ncol(checked$teamB)), 76 | initial.elos = checked$initialElos, 77 | elos.regressed = if(any.regr) out[[2]] else NULL, 78 | teams = names(checked$initialElos), 79 | group = mf$group, 80 | regress = if(any.regr) mf$regress else NULL, 81 | terms = Terms, 82 | na.action = stats::na.action(mf) 83 | ), class = c(if(any.regr) "elo.run.regressed", "elo.run")) 84 | } 85 | 86 | #' @export 87 | print.elo.run <- function(x, ...) 88 | { 89 | cat("\nAn object of class '", class(x)[1], "', containing information on ", 90 | length(x$teams), " teams and ", x$n.matches, " matches.\n\n", sep = "") 91 | invisible(x) 92 | } 93 | 94 | 95 | #' @export 96 | print.elo.run.regressed <- function(x, ...) 97 | { 98 | cat("\nAn object of class '", class(x)[1], "', containing information on ", 99 | length(x$teams), " teams and ", x$n.matches, " matches, with ", 100 | nrow(x$elos.regressed), " regressions.\n\n", sep = "") 101 | invisible(x) 102 | } 103 | -------------------------------------------------------------------------------- /tests/testthat/test_elo.glm.R: -------------------------------------------------------------------------------- 1 | context("Testing the elo.glm function") 2 | 3 | ########################################################################################################### 4 | #### Do some simple checks 5 | ########################################################################################################### 6 | 7 | trn <- tournament 8 | trn$diff <- score(trn$points.Home, trn$points.Visitor) 9 | trn <- trn[trn$diff %in% 0:1, ] 10 | trn$neut <- replace(rep(0, times = nrow(trn)), c(3, 30), 1) 11 | 12 | test_that("elo.glm(running=TRUE) works", { 13 | tmp.glm.run <- elo.glm(diff ~ team.Home + team.Visitor + group(week), data = trn, running = TRUE, skip = 5) 14 | expect_equal( 15 | tmp.glm.run$running.values[44:47], 16 | unname(predict(glm(wins.A ~ . - 1, data = head(tmp.glm.run$data, -8), family = "binomial"), 17 | newdata = tmp.glm.run$data[44:47, ], type = "response")) 18 | ) 19 | expect_equal( 20 | tail(tmp.glm.run$running.values, 4), 21 | unname(predict(glm(wins.A ~ . - 1, data = head(tmp.glm.run$data, -4), family = "binomial"), 22 | newdata = tail(tmp.glm.run$data, 4), type = "response")) 23 | ) 24 | expect_equal(fitted(tmp.glm.run)[1:19], rep(0.5, 19)) 25 | 26 | tmp.glm <- elo.glm(diff ~ team.Home + team.Visitor + group(week), data = trn) 27 | expect_equal(predict(tmp.glm, newdata=head(trn, 2)), predict(tmp.glm.run, newdata=head(trn, 2))) 28 | }) 29 | 30 | test_that("Errors are thrown appropriately", { 31 | expect_error(elo.glm(diff ~ team.Home + team.Visitor, data = trn, running = TRUE, skip = -1), 32 | "0 and 51 (inclusive)", fixed = TRUE) 33 | expect_error(elo.glm(diff ~ team.Home + team.Visitor + group(week), data = trn, running = TRUE, skip = 15), 34 | "0 and 14 (inclusive)", fixed = TRUE) 35 | }) 36 | 37 | test_that("Running elo.glm works with weights", { 38 | trn2 <- trn 39 | trn2$wts <- 1:nrow(trn2) 40 | tmp.glm.run <- elo.glm(diff ~ team.Home + team.Visitor + group(week), data = trn2, running = TRUE, 41 | skip = 5, weights = wts) 42 | expect_equal( 43 | tail(tmp.glm.run$running.values, 4), 44 | unname(predict(glm(wins.A ~ . - 1, data = head(tmp.glm.run$data, -4), family = "binomial", weights = head(trn2$wts, -4)), 45 | newdata = tail(tmp.glm.run$data, 4), type = "response")) 46 | ) 47 | }) 48 | 49 | test_that("predict.elo.glm works correctly", { 50 | tmp.glm <- elo.glm(diff ~ team.Home + team.Visitor + group(week), data = trn) 51 | expect_equal(fitted(tmp.glm), predict(tmp.glm)) 52 | expect_error(predict(tmp.glm, newdata = data.frame(team.Home = "Unknown", team.Visitor = "Unknown 2")), "Unknown teams: Unknown, Unknown 2") 53 | expect_error(predict(tmp.glm, newdata = data.frame(team.Home = "Unknown")), "object 'team.Visitor' not found") 54 | 55 | expect_equal( 56 | tmp.glm$family$linkinv(sum(coef(tmp.glm) * c(1, 1, -1, rep(0, 5)))), 57 | unname(predict(tmp.glm, newdata = data.frame(team.Home = "Athletic Armadillos", team.Visitor = "Blundering Baboons"))) 58 | ) 59 | expect_equal( 60 | tmp.glm$family$linkinv(sum(coef(tmp.glm) * c(1, 1, rep(0, 6)))), 61 | unname(predict(tmp.glm, newdata = data.frame(team.Home = "Athletic Armadillos", team.Visitor = "Helpless Hyenas"))) 62 | ) 63 | 64 | expect_equal( 65 | sum(coef(tmp.glm) * c(1, 1, -1, rep(0, 5))), 66 | unname(predict(tmp.glm, newdata = data.frame(team.Home = "Athletic Armadillos", team.Visitor = "Blundering Baboons"), type = "link")) 67 | ) 68 | expect_equal( 69 | sum(coef(tmp.glm) * c(1, 1, rep(0, 6))), 70 | unname(predict(tmp.glm, newdata = data.frame(team.Home = "Athletic Armadillos", team.Visitor = "Helpless Hyenas"), type = "link")) 71 | ) 72 | 73 | tmp.glm2 <- elo.glm(diff ~ team.Home + team.Visitor + neutral(neut), data = trn) 74 | expect_equal( 75 | tmp.glm2$family$linkinv(sum(coef(tmp.glm2) * c(1, 1, -1, rep(0, 5)))), 76 | unname(predict(tmp.glm2, newdata = data.frame(team.Home = "Athletic Armadillos", team.Visitor = "Blundering Baboons", neut = 0))) 77 | ) 78 | expect_equal( 79 | tmp.glm2$family$linkinv(sum(coef(tmp.glm2) * c(0, 1, rep(0, 6)))), 80 | unname(predict(tmp.glm2, newdata = data.frame(team.Home = "Athletic Armadillos", team.Visitor = "Helpless Hyenas", neut = 1))) 81 | ) 82 | 83 | tmp.glm.adj <- elo.glm(diff ~ team.Home + adjust(team.Visitor, neut) + group(week), data = trn) 84 | expect_error(predict(tmp.glm.adj, data.frame(team.Home = "Blundering Baboons", team.Visitor = "Athletic Armadillos")), 85 | "'neut' not found") 86 | 87 | tmp.glm.neu <- elo.glm(diff ~ team.Home + team.Visitor + neutral(neut) + group(week), data = trn) 88 | expect_error(predict(tmp.glm.neu, data.frame(team.Home = "Blundering Baboons", team.Visitor = "Athletic Armadillos")), 89 | "'neut' not found") 90 | }) 91 | 92 | test_that("adjust() works in elo.glm()", { 93 | tmp.glm.adj0 <- elo.glm(diff ~ team.Home + adjust(team.Visitor, 0) + group(week), data = trn, running = TRUE, skip = 5) 94 | tmp.glm.adj1 <- elo.glm(diff ~ team.Home + adjust(team.Visitor, c(rep(0, 50), 1)) + group(week), data = trn, running = TRUE, skip = 5) 95 | tmp.glm.noad <- elo.glm(diff ~ team.Home + team.Visitor + group(week), data = trn, running = TRUE, skip = 5) 96 | expect_equal(fitted(tmp.glm.adj0)[-51], fitted(tmp.glm.adj1)[-51]) 97 | expect_equal(fitted(tmp.glm.adj0), fitted(tmp.glm.noad)) 98 | }) 99 | -------------------------------------------------------------------------------- /docs/bootstrap-toc.js: -------------------------------------------------------------------------------- 1 | /*! 2 | * Bootstrap Table of Contents v0.4.1 (http://afeld.github.io/bootstrap-toc/) 3 | * Copyright 2015 Aidan Feldman 4 | * Licensed under MIT (https://github.com/afeld/bootstrap-toc/blob/gh-pages/LICENSE.md) */ 5 | (function() { 6 | 'use strict'; 7 | 8 | window.Toc = { 9 | helpers: { 10 | // return all matching elements in the set, or their descendants 11 | findOrFilter: function($el, selector) { 12 | // http://danielnouri.org/notes/2011/03/14/a-jquery-find-that-also-finds-the-root-element/ 13 | // http://stackoverflow.com/a/12731439/358804 14 | var $descendants = $el.find(selector); 15 | return $el.filter(selector).add($descendants).filter(':not([data-toc-skip])'); 16 | }, 17 | 18 | generateUniqueIdBase: function(el) { 19 | var text = $(el).text(); 20 | var anchor = text.trim().toLowerCase().replace(/[^A-Za-z0-9]+/g, '-'); 21 | return anchor || el.tagName.toLowerCase(); 22 | }, 23 | 24 | generateUniqueId: function(el) { 25 | var anchorBase = this.generateUniqueIdBase(el); 26 | for (var i = 0; ; i++) { 27 | var anchor = anchorBase; 28 | if (i > 0) { 29 | // add suffix 30 | anchor += '-' + i; 31 | } 32 | // check if ID already exists 33 | if (!document.getElementById(anchor)) { 34 | return anchor; 35 | } 36 | } 37 | }, 38 | 39 | generateAnchor: function(el) { 40 | if (el.id) { 41 | return el.id; 42 | } else { 43 | var anchor = this.generateUniqueId(el); 44 | el.id = anchor; 45 | return anchor; 46 | } 47 | }, 48 | 49 | createNavList: function() { 50 | return $('
      '); 51 | }, 52 | 53 | createChildNavList: function($parent) { 54 | var $childList = this.createNavList(); 55 | $parent.append($childList); 56 | return $childList; 57 | }, 58 | 59 | generateNavEl: function(anchor, text) { 60 | var $a = $('      '); 61 | $a.attr('href', '#' + anchor); 62 | $a.text(text); 63 | var $li = $('
    • '); 64 | $li.append($a); 65 | return $li; 66 | }, 67 | 68 | generateNavItem: function(headingEl) { 69 | var anchor = this.generateAnchor(headingEl); 70 | var $heading = $(headingEl); 71 | var text = $heading.data('toc-text') || $heading.text(); 72 | return this.generateNavEl(anchor, text); 73 | }, 74 | 75 | // Find the first heading level (`

      `, then `

      `, etc.) that has more than one element. Defaults to 1 (for `

      `). 76 | getTopLevel: function($scope) { 77 | for (var i = 1; i <= 6; i++) { 78 | var $headings = this.findOrFilter($scope, 'h' + i); 79 | if ($headings.length > 1) { 80 | return i; 81 | } 82 | } 83 | 84 | return 1; 85 | }, 86 | 87 | // returns the elements for the top level, and the next below it 88 | getHeadings: function($scope, topLevel) { 89 | var topSelector = 'h' + topLevel; 90 | 91 | var secondaryLevel = topLevel + 1; 92 | var secondarySelector = 'h' + secondaryLevel; 93 | 94 | return this.findOrFilter($scope, topSelector + ',' + secondarySelector); 95 | }, 96 | 97 | getNavLevel: function(el) { 98 | return parseInt(el.tagName.charAt(1), 10); 99 | }, 100 | 101 | populateNav: function($topContext, topLevel, $headings) { 102 | var $context = $topContext; 103 | var $prevNav; 104 | 105 | var helpers = this; 106 | $headings.each(function(i, el) { 107 | var $newNav = helpers.generateNavItem(el); 108 | var navLevel = helpers.getNavLevel(el); 109 | 110 | // determine the proper $context 111 | if (navLevel === topLevel) { 112 | // use top level 113 | $context = $topContext; 114 | } else if ($prevNav && $context === $topContext) { 115 | // create a new level of the tree and switch to it 116 | $context = helpers.createChildNavList($prevNav); 117 | } // else use the current $context 118 | 119 | $context.append($newNav); 120 | 121 | $prevNav = $newNav; 122 | }); 123 | }, 124 | 125 | parseOps: function(arg) { 126 | var opts; 127 | if (arg.jquery) { 128 | opts = { 129 | $nav: arg 130 | }; 131 | } else { 132 | opts = arg; 133 | } 134 | opts.$scope = opts.$scope || $(document.body); 135 | return opts; 136 | } 137 | }, 138 | 139 | // accepts a jQuery object, or an options object 140 | init: function(opts) { 141 | opts = this.helpers.parseOps(opts); 142 | 143 | // ensure that the data attribute is in place for styling 144 | opts.$nav.attr('data-toggle', 'toc'); 145 | 146 | var $topContext = this.helpers.createChildNavList(opts.$nav); 147 | var topLevel = this.helpers.getTopLevel(opts.$scope); 148 | var $headings = this.helpers.getHeadings(opts.$scope, topLevel); 149 | this.helpers.populateNav($topContext, topLevel, $headings); 150 | } 151 | }; 152 | 153 | $(function() { 154 | $('nav[data-toggle="toc"]').each(function(i, el) { 155 | var $nav = $(el); 156 | Toc.init($nav); 157 | }); 158 | }); 159 | })(); 160 | -------------------------------------------------------------------------------- /R/elo.colley.R: -------------------------------------------------------------------------------- 1 | #' Compute a Colley matrix model for a matchup. 2 | #' 3 | #' @inheritParams elo.glm 4 | #' @param weights A vector of weights. Note that these weights are used in the Colley matrix creation, 5 | #' but not the regression. 6 | #' @param k The fraction of a win to be assigned to the winning team. See "details". 7 | #' @examples 8 | #' elo.colley(score(points.Home, points.Visitor) ~ team.Home + team.Visitor, data = tournament, 9 | #' subset = points.Home != points.Visitor) 10 | #' @details 11 | #' See the vignette for details on this method. 12 | #' The differences in assigned scores (from the coefficients of the Colley matrix regression) are fed into a logistic 13 | #' regression model to predict wins or (usually) a linear model to predict margin of victory. 14 | #' In this setting, 'k' indicates the fraction of a win to be assigned to the winning team 15 | #' (and the fraction of a loss to be assigned to the losing team); setting \code{k = 1} (the default) 16 | #' emits the "Bias Free" ranking method presented by Colley. 17 | #' It is also possible to adjust the regression by setting the second argument of 18 | #' \code{\link{adjust}()}. As in \code{\link{elo.glm}}, 19 | #' the intercept represents the home-field advantage. Neutral fields can be indicated 20 | #' using the \code{\link{neutral}()} function, which sets the intercept to 0. 21 | #' 22 | #' @references Colley W.N. Colley's Bias Free College Football Ranking Method: The Colley Matrix Explained. 2002. 23 | #' @seealso \code{\link[stats]{glm}}, \code{\link{summary.elo.colley}}, \code{\link{score}}, 24 | #' \code{\link{mov}}, \code{\link{elo.model.frame}} 25 | #' @name elo.colley 26 | NULL 27 | #> NULL 28 | 29 | #' @rdname elo.colley 30 | #' @export 31 | elo.colley <- function(formula, data, family = "binomial", weights, na.action, subset, k = 1, ..., running = FALSE, skip = 0) 32 | { 33 | Call <- match.call() 34 | Call <- Call[c(1, match(c("formula", "data", "weights", "subset", "na.action", "k"), names(Call), nomatch = 0))] 35 | Call[[1L]] <- quote(elo::elo.model.frame) 36 | Call$required.vars <- c("wins", "elos", "group", "neutral", "weights", "k") 37 | if(is.null(Call$k)) Call$k <- 1 38 | Call$warn.k <- FALSE 39 | Call$ncol.k <- 2 40 | mf <- eval(Call, parent.frame()) 41 | if(nrow(mf) == 0) stop("No (non-missing) observations") 42 | Terms <- stats::terms(mf) 43 | 44 | dat <- check_elo_markovchain_vars(mf) 45 | all.teams <- attr(dat, "teams") 46 | grp <- mf$group 47 | 48 | # we use the convention Ax = x 49 | colley <- do.call(eloColley, dat) 50 | ## come back to this 51 | # if(any(abs(colSums(out[[1]]) - 1) > sqrt(.Machine$double.eps))) warning("colSums(transition matrix) may not be 1") 52 | 53 | vec <- stats::.lm.fit(colley[[1]], colley[[2]])$coefficients 54 | vec <- stats::setNames(vec / sum(vec), all.teams) 55 | difference <- mean_vec_subset_matrix(vec, dat$teamA+1) - mean_vec_subset_matrix(vec, dat$teamB+1) 56 | mc.dat <- data.frame(wins.A = mf$wins.A, home.field = mf$home.field, difference = difference) 57 | if(!all(mf$adj.A == 0)) mc.dat$adj.A <- mf$adj.A 58 | if(!all(mf$adj.B == 0)) mc.dat$adj.B <- mf$adj.B 59 | mc.glm <- stats::glm(wins.A ~ . - 1, family = family, data = mc.dat) 60 | out <- list( 61 | fit = mc.glm, 62 | weights = mf$weights, 63 | matrix = colley[[1]], 64 | response = colley[[2]], 65 | pi = vec, 66 | y = mc.glm$y, 67 | fitted.values = mc.glm$fitted.values, 68 | teams = all.teams, 69 | group = grp, 70 | elo.terms = Terms, 71 | na.action = stats::na.action(mf), 72 | outcome = attr(mf, "outcome") 73 | ) 74 | 75 | if(running) 76 | { 77 | ftd <- rep(0, times = nrow(mc.dat)) 78 | grp2 <- group_to_int(grp, skip) 79 | y <- dat$winsA 80 | adj <- cbind(mf$home.field, mf$adj.A, mf$adj.B) 81 | 82 | for(i in setdiff(seq_len(max(grp2)), seq_len(skip))) 83 | { 84 | if(i == 0) next 85 | sbst <- grp2 %in% 0:(i-1) 86 | dat.tmp <- dat 87 | dat.tmp$winsA <- dat.tmp$winsA[sbst] 88 | dat.tmp$k <- dat.tmp$k[sbst, , drop = FALSE] 89 | dat.tmp$weights <- dat.tmp$weights[sbst] 90 | dat.tmp$teamA <- dat.tmp$teamA[sbst, , drop = FALSE] 91 | dat.tmp$teamB <- dat.tmp$teamB[sbst, , drop = FALSE] 92 | 93 | colley <- do.call(eloColley, dat.tmp) 94 | vec <- stats::.lm.fit(colley[[1]], colley[[2]])$coefficients 95 | vec <- stats::setNames(vec / sum(vec), all.teams) 96 | vec[colley[[3]] == 0] <- NA 97 | difference <- mean_vec_subset_matrix(vec, dat$teamA+1) - mean_vec_subset_matrix(vec, dat$teamB+1) 98 | 99 | # tmpfit <- stats::glm(dat$winsA ~ difference, subset = sbst, family = "binomial") 100 | # ftd[grp2 == i] <- predict(tmpfit, newdata = data.frame(difference = difference[grp2 == i]), type = "link") 101 | 102 | coeff <- stats::glm.fit(cbind(difference, adj)[sbst, , drop=FALSE], 103 | dat.tmp$winsA, family = mc.glm$family, control = mc.glm$control)$coefficients 104 | ftd[grp2 == i] <- apply(cbind(difference, adj)[grp2 == i, , drop=FALSE], 1, mult_na_coef, coeff = coeff) 105 | } 106 | out$running.values <- mc.glm$family$linkinv(ftd) 107 | attr(out$running.values, "group") <- grp2 108 | } 109 | 110 | structure(out, class = c(if(running) "elo.running", "elo.colley")) 111 | } 112 | 113 | #' @export 114 | print.elo.colley <- function(x, ...) 115 | { 116 | cat("\nAn object of class 'elo.colley', containing information on ", length(x$teams), 117 | " teams and ", sum(x$weights), " matches.\n\n", sep = "") 118 | invisible(x) 119 | } 120 | -------------------------------------------------------------------------------- /tests/testthat/test_elo.team.R: -------------------------------------------------------------------------------- 1 | context("Testing the players() function") 2 | 3 | test_that("elo.run works with players()", { 4 | expect_identical( 5 | rnd.mat(elo.run(wins.A ~ players(p1.A, p2.A) + dummy.B, k = 20, data = dat, initial.elos = init.ply), 3), 6 | c("Player 1" = 749.857, "Player 2" = 759.928, "Player 3" = 749.785) 7 | ) 8 | 9 | expect_identical( 10 | rnd.mat(elo.run(wins.A ~ players(p1.A, p2.A, weights = c(0.75, 0.25)) + dummy.B, k = 20, 11 | data = dat, initial.elos = init.ply), 3), 12 | c("Player 1" = 754.928, "Player 2" = 759.946, "Player 3" = 744.767) 13 | ) 14 | 15 | 16 | tmp <- c("Player 1" = 747.737, "Player 2" = 759.784, "Player 3" = 747.521, 17 | "Player 4" = 597.479, "Player 5" = 890.216, "Player 6" = 757.263) 18 | expect_identical( 19 | rnd.mat(elo.run(wins.A ~ players(p1.A, p2.A) + players(p1.B, p2.B), k = 20, 20 | data = dat, initial.elos = init.ply), 3), 21 | tmp 22 | ) 23 | expect_identical( 24 | rnd.fin(elo.run(wins.A ~ players(p1.A, p2.A) + players(p1.B, p2.B), k = 20, 25 | data = dat, initial.elos = init.ply)), 26 | tmp 27 | ) 28 | }) 29 | 30 | 31 | test_that("elo.run works with adjust(players())", { 32 | expect_identical( 33 | rnd.fin(elo.run(wins.A ~ adjust(players(p1.A, p2.A), 20) + players(p1.B, p2.B), k = 20, 34 | data = dat, initial.elos = init.ply)), 35 | c("Player 1" = 747.239, "Player 2" = 759.223, "Player 3" = 747.036, 36 | "Player 4" = 598.251, "Player 5" = 890.777, "Player 6" = 757.474) 37 | ) 38 | }) 39 | 40 | test_that("'group()' and 'regress()' work with players()", { 41 | tmp <- c("Player 1" = 747.117, "Player 2" = 758.827, "Player 3" = 747.944, 42 | "Player 4" = 628.056, "Player 5" = 861.173, "Player 6" = 756.883) 43 | 44 | # as.matrix gives right regression results 45 | expect_identical( 46 | rnd.mat(elo.run(wins.A ~ players(p1.A, p2.A) + players(p1.B, p2.B) + regress(season, 750, 0.2), 47 | k = 20, data = dat, initial.elos = init.ply), 3), 48 | tmp 49 | ) 50 | 51 | # final.elos gives right regression results 52 | expect_identical( 53 | rnd.fin(elo.run(wins.A ~ players(p1.A, p2.A) + players(p1.B, p2.B) + regress(season, 750, 0.2), 54 | k = 20, data = dat, initial.elos = init.ply)), 55 | tmp 56 | ) 57 | 58 | # regression works right the second time 59 | expect_identical( 60 | rnd.fin(elo.run(wins.A ~ players(p1.A, p2.A) + players(p1.B, p2.B) + regress(season, 750, 0.2), 61 | k = 20, data = dat, initial.elos = init.ply), regressed = TRUE), 62 | c("Player 1" = 747.693, "Player 2" = 757.062, "Player 3" = 748.355, 63 | "Player 4" = 652.445, "Player 5" = 838.938, "Player 6" = 755.507) 64 | ) 65 | 66 | # regression works right the second time 67 | expect_identical( 68 | rnd.fin(elo.run(wins.A ~ players(p1.A, p2.A) + players(p1.B, p2.B) + 69 | regress(season, init.ply, 0.2), 70 | k = 20, data = dat, initial.elos = init.ply), regressed = TRUE), 71 | c("Player 1" = 747.407, "Player 2" = 757.062, "Player 3" = 748.069, 72 | "Player 4" = 598.731, "Player 5" = 892.938, "Player 6" = 755.793) 73 | ) 74 | 75 | # as.matrix works right for grouping 76 | expect_identical( 77 | rnd.mat(elo.run(wins.A ~ players(p1.A, p2.A) + players(p1.B, p2.B) + 78 | regress(week, 750, 0.2) + group(week), 79 | k = 20, data = dat, initial.elos = init.ply)), 80 | matrix(c(755, 747.137, 760, 758, 755, 747.137, 590, 628.863, 890, 862, 750, 756.863), nrow = 2, 81 | dimnames = list(NULL, names(init.ply))) 82 | ) 83 | }) 84 | 85 | test_that("elo.prob works with players()", { 86 | expect_identical( 87 | elo.prob(c(750+700, 700+650, 650+750), c(600+900, 600+900, 600+750)), 88 | elo.prob( ~ players(p1.A, p2.A) + players(p1.B, p2.B), data = dat, elos = init.ply2) 89 | ) 90 | expect_identical( 91 | elo.prob(c(750+700+10, 700+650+10, 650+750+10), c(600+900, 600+900, 600+750)), 92 | elo.prob( ~ adjust(players(p1.A, p2.A), 10) + players(p1.B, p2.B), data = dat, elos = init.ply2) 93 | ) 94 | }) 95 | 96 | 97 | results <- elo.run(wins.A ~ adjust(players(p1.A, p2.A), 10) + players(p1.B, p2.B), data = dat, k = 20) 98 | test_that("prediction works correctly with players()", { 99 | newdat <- data.frame(p1.A = "Player 1", p2.A = "Player 4", p1.B = "Player 5", p2.B = "Player 6") 100 | expect_identical( 101 | predict(results, newdata = newdat), 102 | elo.prob(sum(final.elos(results)[c("Player 1", "Player 4")]), 103 | sum(final.elos(results)[c("Player 5", "Player 6")]), adjust.A = 10) 104 | ) 105 | expect_equal(length(predict(results)), nrow(dat)) 106 | }) 107 | 108 | test_that("auc() works correctly with players()", { 109 | expect_equal(auc(results), 0) 110 | }) 111 | 112 | 113 | test_that("xtfrm error goes away (#61)", { 114 | test_players_run <- data.frame( 115 | home_team_win = c(1,0,0,1,0,1), 116 | playerid_1 = c("1","7","13","14","13","14"), 117 | playerid_2 = c("2","8","15","16","15","16"), 118 | playerid_3 = c("3","9","17","18","17","18"), 119 | playerid_6 = c("4","10","19","20","19","20"), 120 | playerid_7 = c("5","11","21","22","21","22"), 121 | playerid_8 = c("6","12","23","24","23","24") 122 | ) 123 | 124 | expect_error(elo.run(home_team_win ~ players(playerid_1, playerid_2, playerid_3) + 125 | players(playerid_6, playerid_7, playerid_8), 126 | data = test_players_run, k = 20), NA) 127 | }) 128 | 129 | 130 | 131 | 132 | 133 | -------------------------------------------------------------------------------- /R/elo.markovchain.R: -------------------------------------------------------------------------------- 1 | #' Compute a Markov chain model for a series of matches. 2 | #' 3 | #' @inheritParams elo.glm 4 | #' @param weights A vector of weights. Note that these weights are used in the Markov Chain model, 5 | #' but not the regression. 6 | #' @param k The probability that the winning team is better given that they won. See details. 7 | #' @examples 8 | #' elo.markovchain(score(points.Home, points.Visitor) ~ team.Home + team.Visitor, data = tournament, 9 | #' subset = points.Home != points.Visitor, k = 0.7) 10 | #' 11 | #' elo.markovchain(mov(points.Home, points.Visitor) ~ team.Home + team.Visitor, family = "gaussian", 12 | #' data = tournament, k = 0.7) 13 | #' @details 14 | #' See the vignette for details on this method. The probabilities we call 'k' purely for convenience. 15 | #' The differences in assigned scores (from the stationary distribution pi) are fed into a logistic 16 | #' regression model to predict wins or (usually) a linear model to predict margin of victory. 17 | #' It is also possible to adjust the regression by setting the second argument of 18 | #' \code{\link{adjust}()}. As in \code{\link{elo.glm}}, 19 | #' the intercept represents the home-field advantage. Neutral fields can be indicated 20 | #' using the \code{\link{neutral}()} function, which sets the intercept to 0. 21 | #' 22 | #' Note that by assigning probabilities in the right way, this function emits the 23 | #' Logistic Regression Markov Chain model (LRMC). 24 | #' @references Kvam, P. and Sokol, J.S. A logistic regression/Markov chain model for NCAA basketball. 25 | #' Naval Research Logistics. 2006. 53; 788-803. 26 | #' @seealso \code{\link[stats]{glm}}, \code{\link{summary.elo.markovchain}}, \code{\link{score}}, 27 | #' \code{\link{mov}}, \code{\link{elo.model.frame}} 28 | #' @name elo.markovchain 29 | NULL 30 | #> NULL 31 | 32 | #' @rdname elo.markovchain 33 | #' @export 34 | elo.markovchain <- function(formula, data, family = "binomial", weights, na.action, subset, k = NULL, ..., running = FALSE, skip = 0) 35 | { 36 | Call <- match.call() 37 | Call <- Call[c(1, match(c("formula", "data", "weights", "subset", "na.action", "k"), names(Call), nomatch = 0))] 38 | Call[[1L]] <- quote(elo::elo.model.frame) 39 | Call$required.vars <- c("wins", "elos", "group", "neutral", "weights", "k") 40 | Call$ncol.k <- 2 41 | mf <- eval(Call, parent.frame()) 42 | if(nrow(mf) == 0) stop("No (non-missing) observations") 43 | Terms <- stats::terms(mf) 44 | 45 | dat <- check_elo_markovchain_vars(mf) 46 | all.teams <- attr(dat, "teams") 47 | grp <- mf$group 48 | 49 | # we use the convention Ax = x 50 | out <- do.call(eloMarkovChain, dat) 51 | if(any(abs(colSums(out[[1]]) - 1) > sqrt(.Machine$double.eps))) warning("colSums(transition matrix) may not be 1") 52 | 53 | eig <- eigen(out[[1]]) 54 | vec <- as.numeric(eig$vectors[, 1]) 55 | vec <- stats::setNames(vec / sum(vec), all.teams) 56 | difference <- mean_vec_subset_matrix(vec, dat$teamA+1) - mean_vec_subset_matrix(vec, dat$teamB+1) 57 | mc.dat <- data.frame(wins.A = mf$wins.A, home.field = mf$home.field, difference = difference) 58 | if(!all(mf$adj.A == 0)) mc.dat$adj.A <- mf$adj.A 59 | if(!all(mf$adj.B == 0)) mc.dat$adj.B <- mf$adj.B 60 | mc.glm <- stats::glm(wins.A ~ . - 1, family = family, data = mc.dat) 61 | out <- list( 62 | fit = mc.glm, 63 | weights = mf$weights, 64 | transition = out[[1]], 65 | n.games = out[[2]], 66 | pi = vec, 67 | eigenvalue = as.numeric(eig$values[1]), 68 | y = mc.glm$y, 69 | fitted.values = mc.glm$fitted.values, 70 | teams = all.teams, 71 | group = grp, 72 | elo.terms = Terms, 73 | na.action = stats::na.action(mf), 74 | outcome = attr(mf, "outcome") 75 | ) 76 | 77 | if(running) 78 | { 79 | ftd <- rep(0, times = nrow(mc.dat)) 80 | grp2 <- group_to_int(grp, skip) 81 | adj <- cbind(mf$home.field, mf$adj.A, mf$adj.B) 82 | 83 | for(i in setdiff(seq_len(max(grp2)), seq_len(skip))) 84 | { 85 | if(i == 0) next 86 | sbst <- grp2 %in% 0:(i-1) 87 | dat.tmp <- dat 88 | dat.tmp$winsA <- dat.tmp$winsA[sbst] 89 | dat.tmp$k <- dat.tmp$k[sbst, , drop = FALSE] 90 | dat.tmp$weights <- dat.tmp$weights[sbst] 91 | dat.tmp$teamA <- dat.tmp$teamA[sbst, , drop = FALSE] 92 | dat.tmp$teamB <- dat.tmp$teamB[sbst, , drop = FALSE] 93 | 94 | eig <- eigen(do.call(eloMarkovChain, dat.tmp)[[1]]) 95 | vec <- as.numeric(eig$vectors[, 1]) 96 | vec <- stats::setNames(vec / sum(vec), all.teams) 97 | vec[vec == 0] <- NA 98 | difference <- mean_vec_subset_matrix(vec, dat$teamA+1) - mean_vec_subset_matrix(vec, dat$teamB+1) 99 | 100 | # tmpfit <- stats::glm(dat$winsA ~ difference, subset = sbst, family = "binomial") 101 | # ftd[grp2 == i] <- predict(tmpfit, newdata = data.frame(difference = difference[grp2 == i]), type = "link") 102 | 103 | coeff <- stats::glm.fit(cbind(difference, adj)[sbst, , drop=FALSE], 104 | dat.tmp$winsA, family = mc.glm$family, control = mc.glm$control)$coefficients 105 | ftd[grp2 == i] <- apply(cbind(difference, adj)[grp2 == i, , drop=FALSE], 1, mult_na_coef, coeff = coeff) 106 | } 107 | out$running.values <- mc.glm$family$linkinv(ftd) 108 | attr(out$running.values, "group") <- grp2 109 | } 110 | 111 | structure(out, class = c(if(running) "elo.running", "elo.markovchain")) 112 | } 113 | 114 | #' @export 115 | print.elo.markovchain <- function(x, ...) 116 | { 117 | cat("\nAn object of class 'elo.markovchain', containing information on ", length(x$teams), 118 | " teams and ", sum(x$n.games)/2, " matches.\n\n", sep = "") 119 | invisible(x) 120 | } 121 | -------------------------------------------------------------------------------- /docs/authors.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | Authors • elo 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 55 | 56 | 57 | 58 | 59 | 60 | 61 |
      62 |
      63 | 123 | 124 | 125 | 126 |
      127 | 128 |
      129 |
      130 |
      131 |

      Authors

      132 |
      133 | 134 |
        135 |
      • 136 |

        Ethan Heinzen. Author, maintainer. 137 |

        138 |
        • 139 |
      140 | 141 |
      142 | 143 |
      144 | 145 | 146 | 147 |
      148 |
      149 |

      Developed by Ethan Heinzen.

      150 |
      151 | 152 |
      153 |

      Site built with pkgdown 1.6.1.

      154 |
      155 | 156 |
      157 |
      158 | 159 | 160 | 161 | 162 | 163 | 164 | 165 | 166 | -------------------------------------------------------------------------------- /docs/404.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | Page not found (404) • elo 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 55 | 56 | 57 | 58 | 59 | 60 | 61 |
      62 |
      63 | 123 | 124 | 125 | 126 |
      127 | 128 |
      129 |
      130 |
      131 |

      Page not found (404)

      132 |
      133 | 134 | Content not found. Please use links in the navbar. 135 | 136 |
      137 | 138 | 143 | 144 |
      145 | 146 | 147 | 148 |
      149 |
      150 |

      Developed by Ethan Heinzen.

      151 |
      152 | 153 |
      154 |

      Site built with pkgdown 1.6.1.

      155 |
      156 | 157 |
      158 |
      159 | 160 | 161 | 162 | 163 | 164 | 165 | 166 | 167 | -------------------------------------------------------------------------------- /R/elo.model.frame.R: -------------------------------------------------------------------------------- 1 | 2 | #' Interpret formulas in \code{elo} functions 3 | #' 4 | #' A helper function to create the \code{model.frame} for many \code{elo} functions. 5 | #' 6 | #' @param formula A formula. See \link[=formula.specials]{the help page for formulas} for details. 7 | #' @param data A \code{data.frame} in which to look for objects in \code{formula}. 8 | #' @param na.action A function which indicates what should happen when the data contain NAs. 9 | #' @param subset An optional vector specifying a subset of observations. 10 | #' @param k A constant k-value (or a vector, where appropriate). 11 | #' @param ... Other arguments (not in use at this time). 12 | #' @param required.vars One or more of \code{c("wins", "elos", "k", "group", "regress")}, 13 | #' denoting which variables are required to appear in the final model.frame. 14 | #' @param warn.k Should a warning be issued if \code{k} is specified as an argument and in \code{formula}? 15 | #' @param ncol.k How many columns (\code{NCOL}) should \code{k} have? 16 | #' @param ncol.elos How many Elo columns are expected? 17 | #' @seealso \code{\link{elo.run}}, \code{\link{elo.calc}}, \code{\link{elo.update}}, \code{\link{elo.prob}} 18 | #' @export 19 | elo.model.frame <- function(formula, data, na.action, subset, k = NULL, ..., required.vars = "elos", warn.k = TRUE, ncol.k = 1, ncol.elos = 2) 20 | { 21 | Call <- match.call() 22 | required.vars <- match.arg(required.vars, c("wins", "elos", "k", "group", "regress", "neutral", "weights"), several.ok = TRUE) 23 | indx <- match(c("formula", "data", "subset", "na.action", "weights"), names(Call), nomatch = 0) 24 | if(indx[1] == 0) stop("A formula argument is required.") 25 | 26 | temp.call <- Call[c(1, indx)] 27 | temp.call[[1L]] <- quote(stats::model.frame) 28 | specials <- c("adjust", "k", "group", "regress", "neutral", "players") 29 | 30 | temp.call$formula <- if(missing(data)) 31 | { 32 | stats::terms(formula, specials) 33 | } else stats::terms(formula, specials, data = data) 34 | 35 | mf <- eval(temp.call, parent.frame()) 36 | if(nrow(mf) == 0) stop("No (non-missing) observations") 37 | 38 | Terms <- stats::terms(mf) 39 | naaction <- stats::na.action(mf) 40 | 41 | ##################################################################### 42 | 43 | has.wins <- attr(Terms, "response") == 1 44 | 45 | k.col <- attr(Terms, "specials")$k 46 | has.k <- !null_or_length0(k.col) || !is.null(k) 47 | 48 | grp.col <- attr(Terms, "specials")$group 49 | reg.col <- attr(Terms, "specials")$regress 50 | neu.col <- attr(Terms, "specials")$neutral 51 | wts.col <- which(names(mf) == "(weights)") 52 | 53 | if("wins" %in% required.vars && !has.wins) 54 | { 55 | stop("A 'wins' component is required in the left-hand side of 'formula'.") 56 | } 57 | 58 | if("k" %in% required.vars && !has.k) 59 | { 60 | stop("'k' is not in 'formula' or specified as an argument.") 61 | } else if(!null_or_length0(k.col) && !is.null(k) && warn.k) 62 | { 63 | warning("'k = ' argument being ignored.") 64 | } 65 | 66 | # need all the parens b/c ! is a low-precident operator 67 | sum.nonempty <- (!null_or_length0(k.col)) + (!null_or_length0(grp.col)) + (!null_or_length0(reg.col)) + 68 | (!null_or_length0(neu.col)) + (!null_or_length0(wts.col)) 69 | 70 | if(has.wins + sum.nonempty + ncol.elos != ncol(mf)) 71 | { 72 | stop("'formula' not specified correctly: found ", ncol(mf), " columns; expected ", 73 | has.wins + sum.nonempty + ncol.elos) 74 | } 75 | 76 | # figure out which columns are the "real" ones 77 | elo.cols <- if(sum.nonempty == 0) 78 | { 79 | (1:ncol.elos) + has.wins 80 | } else setdiff(1:ncol(mf), c(if(has.wins) 1, k.col, grp.col, reg.col, neu.col, wts.col)) 81 | stopifnot(ncol.elos %in% 1:2) 82 | if(length(elo.cols) != ncol.elos) stop("Trouble finding the Elo columns.") 83 | 84 | ##################################################################### 85 | 86 | out <- data.frame(row.names = 1:nrow(mf)) # in case one of the next two lines is a matrix 87 | out$elo.A <- remove_elo_adjust(mf[[elo.cols[1]]]) 88 | if(ncol.elos == 2) out$elo.B <- remove_elo_adjust(mf[[elo.cols[2]]]) 89 | 90 | if("wins" %in% required.vars) 91 | { 92 | out$wins.A <- as.numeric(mf[[1]]) 93 | if(!(is.mov <- inherits(mf[[1]], "elo.mov"))) validate_score(out$wins.A) 94 | } else is.mov <- FALSE 95 | if("k" %in% required.vars) 96 | { 97 | k <- if(null_or_length0(k.col)) 98 | { 99 | if(!(length(k) %in% c(1, nrow(mf)))) stop("'k' must be length 1 or the number of rows of data") 100 | if(length(k) == 1) k <- rep(k, nrow(mf)) 101 | k 102 | } else mf[[k.col]] 103 | stopifnot(ncol.k %in% 1:2) 104 | if(ncol.k == 2 && NCOL(k) == 1) k <- matrix(c(k, k), ncol = 2) 105 | out$k <- k 106 | if(!is.numeric(out$k) || anyNA(out$k)) stop("'k' should be numeric and non-NA.") 107 | } 108 | if("group" %in% required.vars) 109 | { 110 | out$group <- if(null_or_length0(grp.col)) TRUE else mf[[grp.col]] 111 | } 112 | if("regress" %in% required.vars) 113 | { 114 | out$regress <- if(null_or_length0(reg.col)) 115 | { 116 | regress(rep(FALSE, times = nrow(out)), 1500, 0, FALSE) 117 | } else mf[[reg.col]] 118 | } 119 | if("neutral" %in% required.vars) 120 | { 121 | out$home.field <- if(null_or_length0(neu.col)) rep(1, times = nrow(out)) else 1 - mf[[neu.col]] 122 | } 123 | if("weights" %in% required.vars) 124 | { 125 | out$weights <- if(null_or_length0(wts.col)) 126 | { 127 | rep(1, times = nrow(out)) 128 | } else mf[["(weights)"]] 129 | } 130 | 131 | adjs <- attr(Terms, "specials")$adjust 132 | 133 | out$adj.A <- if(null_or_length0(adjs) || !any(adjs == elo.cols[1])) 0 else attr(fix_adjust(mf[[elo.cols[1]]], naaction), "adjust") 134 | if(ncol.elos == 2) out$adj.B <- if(null_or_length0(adjs) || !any(adjs == elo.cols[2])) 0 else attr(fix_adjust(mf[[elo.cols[2]]], naaction), "adjust") 135 | 136 | if(!is.numeric(out$adj.A) || (!is.null(out$adj.B) && !is.numeric(out$adj.B))) stop("Any Elo adjustments should be numeric!") 137 | 138 | attr(out, "terms") <- Terms 139 | attr(out, "na.action") <- naaction 140 | attr(out, "outcome") <- if(is.mov) "mov" else "score" 141 | out 142 | } 143 | -------------------------------------------------------------------------------- /docs/articles/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | Articles • elo 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 55 | 56 | 57 | 58 | 59 | 60 | 61 |
      62 |
      63 | 123 | 124 | 125 | 126 |
      127 | 128 |
      129 |
      130 |
      131 |

      Articles

      132 |
      133 | 134 |
      135 |

      Vignettes

      136 |

      137 | 138 |
      139 |
      Introduction to Elo Rankings and the 'elo' Package
      140 |
      141 |
      Calculating Running Elo Updates
      142 |
      143 |
      Comparison Methods
      144 |
      145 |
      146 |
      147 |
      148 |
      149 | 150 | 151 | 161 |
      162 | 163 | 164 | 165 | 166 | 167 | 168 | 169 | 170 | -------------------------------------------------------------------------------- /R/predict.R: -------------------------------------------------------------------------------- 1 | 2 | #' Make Predictions on an \code{elo} Object 3 | #' 4 | #' @param object An model from which to get predictions. 5 | #' @param newdata A new dataset containing the same variables as the call 6 | #' that made \code{object}. If missing, the predicted win probabilities from 7 | #' \code{object} will be returned. 8 | #' @param regressed See the note on \code{\link{final.elos}}. 9 | #' @param type See \code{\link[stats]{predict.glm}} 10 | #' @param running logical, denoting whether to use the running predicted values. Only makes 11 | #' sense if \code{newdata} is missing. 12 | #' @param ... Other arguments. 13 | #' @return A vector of win probabilities. 14 | #' @examples 15 | #' data(tournament) 16 | #' t1 <- head(tournament, -3) 17 | #' t2 <- tail(tournament, 3) 18 | #' results <- elo.run(score(points.Home, points.Visitor) ~ team.Home + team.Visitor, 19 | #' data = t1, k = 20) 20 | #' predict(results) 21 | #' predict(results, newdata = t2) 22 | #' 23 | #' results <- elo.glm(score(points.Home, points.Visitor) ~ team.Home + team.Visitor, data = t1, 24 | #' subset = points.Home != points.Visitor) 25 | #' predict(results) 26 | #' predict(results, newdata = t2) 27 | #' 28 | #' results <- elo.markovchain(score(points.Home, points.Visitor) ~ team.Home + team.Visitor, data = t1, 29 | #' subset = points.Home != points.Visitor, k = 0.7) 30 | #' predict(results) 31 | #' predict(results, newdata = t2) 32 | #' 33 | #' results <- elo.colley(score(points.Home, points.Visitor) ~ team.Home + team.Visitor, data = t1, 34 | #' subset = points.Home != points.Visitor) 35 | #' predict(results) 36 | #' predict(results, newdata = t2) 37 | #' 38 | #' results <- elo.winpct(score(points.Home, points.Visitor) ~ team.Home + team.Visitor, data = t1, 39 | #' subset = points.Home != points.Visitor, k = 0.7) 40 | #' predict(results) 41 | #' predict(results, newdata = t2) 42 | #' @details 43 | #' Note that the \code{"elo.glm.running"} objects will use a model fit on all the data to predict. 44 | #' @name predict.elo 45 | NULL 46 | #> NULL 47 | 48 | #' @rdname predict.elo 49 | #' @export 50 | predict.elo.run <- function(object, newdata, ...) 51 | { 52 | if(missing(newdata) || is.null(newdata)) return(fitted(object)) 53 | form <- clean_elo_formula(stats::terms(object)) 54 | elo.prob(form, data = newdata, ..., elos = final.elos(object)) 55 | } 56 | 57 | 58 | #' @rdname predict.elo 59 | #' @export 60 | predict.elo.run.regressed <- function(object, newdata, regressed = FALSE, ...) 61 | { 62 | if(missing(newdata) || is.null(newdata)) return(fitted(object)) 63 | form <- clean_elo_formula(stats::terms(object)) 64 | elo.prob(form, data = newdata, ..., elos = final.elos(object, regressed = regressed)) 65 | } 66 | 67 | #' @rdname predict.elo 68 | #' @export 69 | predict.elo.run.multiteam <- function(object, newdata, ...) 70 | { 71 | if(missing(newdata) || is.null(newdata)) return(fitted(object)) 72 | form <- clean_elo_formula(stats::terms(object)) 73 | mf <- elo.model.frame(form, data = newdata, ncol.elos = 1) 74 | if(any(mf$adjust.A != 0)) warning("Any adjustments using 'adjust()' are being ignored.") 75 | 76 | elo.prob(mf$elo.A, ..., elos = final.elos(object, ...)) 77 | } 78 | 79 | #' @rdname predict.elo 80 | #' @export 81 | predict.elo.glm <- function(object, newdata, type = "response", ...) 82 | { 83 | if(missing(newdata) || is.null(newdata)) return(stats::predict.glm(object, newdata = NULL, type = type, ...)) 84 | form <- clean_elo_formula(object$elo.terms, drop.neutral = FALSE) 85 | mf <- elo.model.frame(form, data = newdata, required.vars = c("elos", "neutral")) 86 | newdata.wide <- mf_to_wide(mf, teams = object$teams) 87 | stats::predict.glm(object, newdata = newdata.wide, type = type, ...) 88 | } 89 | 90 | 91 | #' @rdname predict.elo 92 | #' @export 93 | predict.elo.running <- function(object, newdata, running = TRUE, ...) 94 | { 95 | if((missing(newdata) || is.null(newdata)) && running) 96 | { 97 | return(fitted(object, running = TRUE)) 98 | } else if(missing(newdata) || is.null(newdata)) return(fitted(object, running = FALSE)) 99 | NextMethod() 100 | } 101 | 102 | #' @rdname predict.elo 103 | #' @export 104 | predict.elo.markovchain <- function(object, newdata, ...) 105 | { 106 | if(missing(newdata) || is.null(newdata)) return(fitted(object)) 107 | form <- clean_elo_formula(object$elo.terms, drop.neutral = FALSE) 108 | mf <- elo.model.frame(form, data = newdata, required.vars = c("elos", "neutral")) 109 | if(!is.players(mf$elo.A)) mf$elo.A <- players(mf$elo.A) 110 | if(!is.players(mf$elo.B)) mf$elo.B <- players(mf$elo.B) 111 | 112 | dat <- data.frame( 113 | difference = mean_vec_subset_matrix(object$pi, mf$elo.A) - mean_vec_subset_matrix(object$pi, mf$elo.B), 114 | home.field = mf$home.field, adj.A = mf$adj.A, adj.B = mf$adj.B 115 | ) 116 | stats::predict.glm(object$fit, newdata = dat, type = "response", ...) 117 | } 118 | 119 | #' @rdname predict.elo 120 | #' @export 121 | predict.elo.colley <- function(object, newdata, ...) 122 | { 123 | if(missing(newdata) || is.null(newdata)) return(fitted(object)) 124 | form <- clean_elo_formula(object$elo.terms, drop.neutral = FALSE) 125 | mf <- elo.model.frame(form, data = newdata, required.vars = c("elos", "neutral")) 126 | if(!is.players(mf$elo.A)) mf$elo.A <- players(mf$elo.A) 127 | if(!is.players(mf$elo.B)) mf$elo.B <- players(mf$elo.B) 128 | 129 | dat <- data.frame( 130 | difference = mean_vec_subset_matrix(object$pi, mf$elo.A) - mean_vec_subset_matrix(object$pi, mf$elo.B), 131 | home.field = mf$home.field, adj.A = mf$adj.A, adj.B = mf$adj.B 132 | ) 133 | stats::predict.glm(object$fit, newdata = dat, type = "response", ...) 134 | } 135 | 136 | 137 | #' @rdname predict.elo 138 | #' @export 139 | predict.elo.winpct <- function(object, newdata, ...) 140 | { 141 | if(missing(newdata) || is.null(newdata)) return(fitted(object)) 142 | form <- clean_elo_formula(object$elo.terms, drop.neutral = FALSE) 143 | mf <- elo.model.frame(form, data = newdata, required.vars = c("elos", "neutral")) 144 | if(!is.players(mf$elo.A)) mf$elo.A <- players(mf$elo.A) 145 | if(!is.players(mf$elo.B)) mf$elo.B <- players(mf$elo.B) 146 | 147 | dat <- data.frame( 148 | difference = mean_vec_subset_matrix(object$win.pct, mf$elo.A) - mean_vec_subset_matrix(object$win.pct, mf$elo.B), 149 | home.field = mf$home.field, adj.A = mf$adj.A, adj.B = mf$adj.B 150 | ) 151 | stats::predict.glm(object$fit, newdata = dat, type = "response", ...) 152 | } 153 | --------------------------------------------------------------------------------