From 5fe9f5a268900b86c3125e2d037a669cf80e12b5 Mon Sep 17 00:00:00 2001 From: Torvaney Date: Sun, 15 Jul 2018 01:10:30 +0100 Subject: [PATCH] Allow arguments to optim Allow user to pass on arguments to optim in the dixoncoles fitting methods. Also allow initial parameters to be supplied to dixoncoles_* (optionally). --- R/dixoncoles.R | 44 ++++++++++++++++++++++---------- man/dixoncoles.Rd | 4 ++- man/dixoncoles_ext.Rd | 7 ++--- tests/testthat/test-dixoncoles.R | 16 +++++++----- 4 files changed, 47 insertions(+), 24 deletions(-) diff --git a/R/dixoncoles.R b/R/dixoncoles.R index 41ae8b9..6646936 100644 --- a/R/dixoncoles.R +++ b/R/dixoncoles.R @@ -22,6 +22,7 @@ #' `as.data.frame` to a data frame) containing the variables in the model. #' @param weights A formula describing an expression to calculate the weight for #' each game. All games weighted equally by default. +#' @param ... Arguments passed onto `dixoncoles_ext`. #' #' @return A list with component `par` containing the best set of parameters #' found. See `optim` for details. @@ -32,7 +33,7 @@ #' @examples #' fit <- dixoncoles(~hgoal, ~agoal, ~home, ~away, premier_league_2010) #' -dixoncoles <- function(hgoal, agoal, hteam, ateam, data, weights = ~1) { +dixoncoles <- function(hgoal, agoal, hteam, ateam, data, weights = ~1, ...) { # Check input hvar <- f_eval(hteam, data) @@ -50,7 +51,7 @@ dixoncoles <- function(hgoal, agoal, hteam, ateam, data, weights = ~1) { data$hfa <- TRUE - res <- dixoncoles_ext(f1, f2, weights = weights, data = data) + res <- dixoncoles_ext(f1, f2, weights = weights, data = data, ...) # Hack to let predict.dixoncoles know to add HFA res$implicit_hfa <- TRUE @@ -79,8 +80,9 @@ dixoncoles <- function(hgoal, agoal, hteam, ateam, data, weights = ~1) { #' each game. #' @param data Data frame, list or environment (or object coercible by #' `as.data.frame` to a data frame) containing the variables in the model. -#' @param method The optimisation method to use (see `optim`). -#' @param control Passed onto `optim`. +#' @param init Initial parameter values. If it is `NULL`, 0 is used for all +#' values. +#' @param ... Arguments passed onto `optim`. #' #' @return A list with component `par` containing the best set of parameters #' found. See `optim` for details. @@ -92,20 +94,36 @@ dixoncoles <- function(hgoal, agoal, hteam, ateam, data, weights = ~1) { #' agoal ~ off(away) + def(home) + 0, #' weights = ~1, # All games weighted equally #' data = premier_league_2010) -dixoncoles_ext <- function(f1, f2, weights, data, method = "BFGS", control = list()) { +dixoncoles_ext <- function(f1, f2, weights, data, init = NULL, ...) { + # Handle args to pass onto optim including defaults + dots <- list(...) + + if (!("method" %in% names(dots))) { + dots["method"] <- "BFGS" + } + + # Wrangle data and intial params modeldata <- .dc_modeldata(f1, f2, weights, data) - params <- rep_len(0, length(modeldata$vars) + 1) - names(params) <- c(modeldata$vars, "rho") + if (is.null(init)) { + params <- rep_len(0, length(modeldata$vars) + 1) + names(params) <- c(modeldata$vars, "rho") + } else { + params <- init + } - res <- optim( - params, - .dc_objective_function, - modeldata = modeldata, - method = method, - control = control + # Create arguments to optim + # We need to do this + do.call so that we can pass on ... with default args + # Maybe there's a better way? (in rlib?) + args <- c( + list(par = params, + fn = .dc_objective_function, + modeldata = modeldata), + dots ) + res <- do.call(optim, args) + res$f1 <- f1 res$f2 <- f2 res$weights <- weights diff --git a/man/dixoncoles.Rd b/man/dixoncoles.Rd index c182bec..b929b29 100644 --- a/man/dixoncoles.Rd +++ b/man/dixoncoles.Rd @@ -4,7 +4,7 @@ \alias{dixoncoles} \title{Dixon-Coles model for estimating team strengths} \usage{ -dixoncoles(hgoal, agoal, hteam, ateam, data, weights = ~1) +dixoncoles(hgoal, agoal, hteam, ateam, data, weights = ~1, ...) } \arguments{ \item{hgoal}{A formula describing the home goals column in `data`, or a @@ -24,6 +24,8 @@ vector containing the away team name for a set of games.} \item{weights}{A formula describing an expression to calculate the weight for each game. All games weighted equally by default.} + +\item{...}{Arguments passed onto `dixoncoles_ext`.} } \value{ A list with component `par` containing the best set of parameters diff --git a/man/dixoncoles_ext.Rd b/man/dixoncoles_ext.Rd index 4cd42d4..00dc74d 100644 --- a/man/dixoncoles_ext.Rd +++ b/man/dixoncoles_ext.Rd @@ -4,7 +4,7 @@ \alias{dixoncoles_ext} \title{A generic Dixon-Coles model for estimating team strengths} \usage{ -dixoncoles_ext(f1, f2, weights, data, method = "BFGS", control = list()) +dixoncoles_ext(f1, f2, weights, data, init = NULL, ...) } \arguments{ \item{f1}{A formula describing the model for home goals.} @@ -17,9 +17,10 @@ each game.} \item{data}{Data frame, list or environment (or object coercible by `as.data.frame` to a data frame) containing the variables in the model.} -\item{method}{The optimisation method to use (see `optim`).} +\item{init}{Initial parameter values. If it is `NULL`, 0 is used for all +values.} -\item{control}{Passed onto `optim`.} +\item{...}{Arguments passed onto `optim`.} } \value{ A list with component `par` containing the best set of parameters diff --git a/tests/testthat/test-dixoncoles.R b/tests/testthat/test-dixoncoles.R index 11d3021..ee1feb0 100644 --- a/tests/testthat/test-dixoncoles.R +++ b/tests/testthat/test-dixoncoles.R @@ -152,13 +152,15 @@ test_that("Home advantage estimates are reasonable", { lapply(1:5, function(data) { resampled_data <- modelr::resample_bootstrap(premier_league_2010) # Supress warnings related to poorly specified bounds (see #1) - fit <- suppressWarnings(dixoncoles( - ~hgoal, - ~agoal, - ~home, - ~away, - as.data.frame(resampled_data) - )) + fit <- suppressWarnings( + dixoncoles( + ~hgoal, + ~agoal, + ~home, + ~away, + as.data.frame(resampled_data) + ) + ) hfa <- fit$par[["hfa"]] expect_gt(hfa, 0.1)