https://github.com/ekstroem/soccer
Evaluating sport tournament predictions
https://github.com/ekstroem/soccer
Last synced: about 1 year ago
JSON representation
Evaluating sport tournament predictions
- Host: GitHub
- URL: https://github.com/ekstroem/soccer
- Owner: ekstroem
- Created: 2019-01-29T18:37:38.000Z (over 7 years ago)
- Default Branch: master
- Last Pushed: 2019-07-03T13:24:43.000Z (almost 7 years ago)
- Last Synced: 2025-05-16T07:52:30.888Z (about 1 year ago)
- Language: R
- Homepage:
- Size: 40 KB
- Stars: 3
- Watchers: 2
- Forks: 0
- Open Issues: 0
-
Metadata Files:
- Readme: README.md
Awesome Lists containing this project
README
# socceR package
Development version of the R package `socceR` for evaluating and comparing sport tournament predictions.
To install the development version of `socceR` run the following command from
within R (this requires that the `devtools` package is already installed on the system.)
devtools::install_github('ekstroem/socceR')
## Evaluating predictions
```
m1 <- matrix(c(1, 0, 0, 0, 0, 1, 0, 0, 0, 0, .5, .5, 0, 0, .5, .5), 4)
m1 # Prediction where certain on the top ranks
m2 <- matrix(c(.5, .5, 0, 0, .5, .5, 0, 0, 0, 0, 1, 0, 0, 0, 0, 1), 4)
m2 # Prediction where the groups are okay
m3 <- matrix(c(.5, .5, 0, 0, .5, .5, 0, 0, 0, 0, .5, .5, 0, 0, .5, .5), 4)
m3 # Prediction where no clue about anything
m4 <- matrix(rep(1/4, 16), 4)
m4
rps(m1, c(1, 2, 3, 4)) # Better prediction
rps(m2, c(1, 2, 3, 4)) # Slightly worse prediction
rps(m3, c(1, 2, 3, 4)) # Slightly worse prediction
rps(m4, c(1, 2, 3, 4)) # Slightly worse prediction
optimize_weights(list(m1, m2, m3, m4), 1:4)
```
# Weighing predictions over multiple tournaments
This section is not quite finished yet and is more or less just proof-of-concept
Let's create another set of predictions fro another tournament but with the same methods as above.
```
M1 <- matrix(c(.8, .2, 0, 0, .1, .7, .2, 0, .05, .05, .4, .5, .05, .05, .4, .5), 4)
M1 # Prediction where certain on the top ranks
M2 <- matrix(rev(c(.8, .2, 0, 0, .1, .7, .2, 0, .05, .05, .4, .5, .05, .05, .4, .5)), 4)
M2 # Prediction where the groups are okay
M3 <- matrix(c(.5, .5, 0, 0, .5, .5, 0, 0, 0, 0, .5, .5, 0, 0, .5, .5), 4)
M3 # Prediction where no clue about anything
M4 <- matrix(rep(1/4, 16), 4)
M4
```
Let us find the optimal weights (and assume that outcome was the same in the two tournaments)
```
optimize_weights2 <- function(predictionlist, outcome, FUN=rps) {
# Sanity checks needed:
# Check equal dimensions of matrices
# Check match with outcome
# Start by finding their individual RPS scores
startrps <- rowSums(sapply(predictionlist, function(plist) { sapply(plist, function(mat) { FUN(mat, outcome)} )})
)
# Should be possible to get much faster
weightedrps <- function(weights) {
weights <- exp(weights)/sum(exp(weights))
Reduce('+', lapply(predictionlist, function(x) {
FUN(Reduce('+', lapply(1:length(weights), function(i){weights[i]*x[[i]]})), outcome)
}))
}
res <- optim(exp(-startrps), weightedrps)
exp(res$par)/sum(exp(res$par))
}
```
The function above should probably be wrapped in a proper function. If we run
```
optimize_weights2(list(list(m1, m2, m3, m4), list(M1, M2, M3, M4)), 1:4)
```
then we get the optimal weights across multiple tournaments.