#' Traing AFLELO Model
#'
#' Train an AFLELO Model
#'
#' @param model aflelo_model object
#' @param matches data.frame containg matche results to train using, see
#' [matches] for an example
#'
#' @return aflelo_model with ratings history based on the provided matches
#' @examples
#' data("matches")
#' matches1997 <- matches[matches$Season == 1997, ]
#' model <- aflelo_model()
#' train_model(model, matches1997)
#'
#' @export
train_model <- function(model, matches) {
checkmate::assert_class(model, "aflelo_model")
checkmate::assert_data_frame(matches, min.rows = 1)
for (i in seq_len(nrow(matches))) {
match_row <- matches[i, ]
home <- match_row$HomeTeam
away <- match_row$AwayTeam
ground <- match_row$Ground
season <- match_row$Season
round <- match_row$Round
if (season > model$season) {
model <- new_season(model)
model$round <- round
}
if (round != model$round) {
model <- update_rating_history(model)
model$round <- round
}
pred_result <- predict_result(model, home, away, ground)
pred_margin <- predict_margin(model, pred_result)
match <- aflelo_match(season = season,
round = round,
home = home,
away = away,
ground = ground,
pred_margin = pred_margin,
home_total = match_row$HomeTotal,
away_total = match_row$AwayTotal)
model <- add_match(model, match)
}
return(model)
}
#' Add match
#'
#' Add the results of a match to an AFLELO Model
#'
#' @param model afelo_model object
#' @param match aflelo_match object
#'
#' @return aflelo_model with ratings updated based on the match
#' @examples
#' model <- aflelo_model()
#' match <- aflelo_match(2000, "R1", "Melbourne", "Adelaide", "M.C.G.",
#' 10, 110, 102)
#' aflelo:::add_match(model, match)
add_match <- function(model, match) {
checkmate::assert_class(model, "aflelo_model")
checkmate::assert_class(match, "aflelo_match")
if (match$season > model$season) {
model <- new_season(model)
model$round <- match$round
}
if (match$round != model$round) {
model <- update_rating_history(model)
model$round <- match$round
}
pred_result <- convert_margin(model, match$pred_margin)
real_result <- convert_margin(model, match$real_margin)
new_home_rating <- calc_new_rating(model, match$home, real_result,
pred_result)
new_away_rating <- calc_new_rating(model, match$away, 1 - real_result,
1 - pred_result)
if (!(match$round %in% c("QF", "EF", "SF", "PF", "GF"))) {
home_points <- 0
away_points <- 0
if (match$real_margin > 0) {
home_points <- 4
} else if (match$real_margin < 0) {
away_points <- 4
} else if(match$real_margin == 0) {
home_points <- 2
away_points <- 2
}
model <- update_ladder(model, match$home, home_points, match$home_total,
match$away_total)
model <- update_ladder(model, match$away, away_points, match$away_total,
match$home_total)
}
model <- update_rating(model, match$home, new_home_rating)
model <- update_rating(model, match$away, new_away_rating)
model$match_history <- rbind(model$match_history,
data.frame(Season = model$season,
Round = model$round,
HomeTeam = match$home,
AwayTeam = match$away,
Ground = match$ground,
Predicted = match$pred_margin,
Margin = match$real_margin))
validate_aflelo_model(model)
}
#' Calculate new rating
#'
#' Calculate new rating for a team based on predicted and real results
#'
#' @param model aflelo_model object
#' @param team name of team to calculate new rating for
#' @param real_result real result probability
#' @param pred_result predicted result probability
#'
#' @return New rating value for the team
#' @examples
#' model <- aflelo_model()
#' match <- aflelo_match(2000, "R1", "Melbourne", "Adelaide", "M.C.G.",
#' 10, 110, 102)
#' real_result <- aflelo:::convert_margin(model, match$real_margin)
#' pred_result <- aflelo:::convert_margin(model, match$pred_margin)
#' aflelo:::calc_new_rating(model, "Melbourne", real_result, pred_result)
calc_new_rating <- function(model, team, real_result, pred_result) {
checkmate::assert_class(model, "aflelo_model")
checkmate::assert_character(team, len = 1)
checkmate::assert_number(real_result, lower = 0, upper = 1)
checkmate::assert_number(pred_result, lower = 0, upper = 1)
if (model$round %in% c("R1", "R2", "R3", "R4", "R5")) {
adjust_k <- model$params$adjust_k_early
} else if (model$round %in% c("QF", "EF", "SF", "PF", "GF")) {
adjust_k <- model$params$adjust_k_finals
} else {
adjust_k <- model$params$adjust_k_normal
}
old_rating <- model$ratings$Rating[model$ratings$Team == team]
new_rating <- old_rating + adjust_k * (real_result - pred_result)
return(new_rating)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.