From 5960e4c484b73d62ccc571826480a35b661e6c52 Mon Sep 17 00:00:00 2001 From: Philip Bulsink Date: Tue, 6 Oct 2026 10:38:21 -0400 Subject: [PATCH 1/2] refactor: unify league update/summary entry points and fix params cross-refs (#42) Makes updateModel() and dailySummary() the single public entry points for both leagues. The former league-specific exports updateDC(), updatePWHLDC(), updatePWHLModel(), and dailyPWHLSummary() are now internal (.update_dc_nhl(), .update_dc_pwhl(), .update_model_pwhl(), .daily_summary_pwhl()), and the params argument across the NHL prediction/simulation/social-media functions now points at the correct params source. - Closes #42 --- NAMESPACE | 4 - NEWS.md | 1 + R/data.R | 10 +- R/frontend-core.R | 6 +- R/frontend-daily-summary.R | 5 +- R/frontend-plots.R | 2 +- R/frontend-social.R | 6 +- R/graphics-odds.R | 4 +- R/graphics-plots.R | 2 +- R/graphics-tables.R | 4 +- R/nhl-dixon-coles-predict.R | 117 +++++++++++------- R/nhl-dixon-coles-workflow.R | 37 +++--- R/nhl-league-playoffs.R | 12 +- R/nhl-league-predictions-log.R | 2 +- R/nhl-league-simulation.R | 14 ++- R/pwhl-daily-summary.R | 16 +-- R/pwhl-model-core.R | 10 +- man/DCPredict.Rd | 2 +- man/dailyPWHLSummary.Rd | 30 ----- man/daily_odds_table.Rd | 2 +- man/dcLambda.Rd | 2 +- man/dcPredictVectorized.Rd | 44 +++++++ man/dcProbArray.Rd | 28 +++++ man/dcProbMatrix.Rd | 2 +- man/dcResult.Rd | 2 +- man/dcSample.Rd | 2 +- man/dot-daily_summary_pwhl.Rd | 19 +++ man/dot-update_dc_nhl.Rd | 43 +++++++ ...{updatePWHLDC.Rd => dot-update_dc_pwhl.Rd} | 7 +- ...ePWHLModel.Rd => dot-update_model_pwhl.Rd} | 7 +- man/getSeriesOdds.Rd | 2 +- man/loopless_sim.Rd | 2 +- man/playoffDC.Rd | 2 +- man/playoffSolverEngine.Rd | 2 +- man/playoffWin.Rd | 2 +- man/plot_game.Rd | 2 +- man/plot_odds_today.Rd | 2 +- man/plot_playoff_series_odds.Rd | 2 +- man/prob_matrix.Rd | 2 +- man/pwhl_beta.Rd | 2 +- man/pwhl_eta.Rd | 2 +- man/pwhl_k.Rd | 2 +- man/pwhl_m.Rd | 2 +- man/pwhl_rho.Rd | 2 +- man/randomSeriesWinner.Rd | 2 +- man/recordTodaysPredictions.Rd | 2 +- man/remainderSeasonDC.Rd | 2 +- man/series_odds_table.Rd | 2 +- man/sim_batch.Rd | 29 +++++ man/sim_engine.Rd | 2 +- man/sim_odds_results.Rd | 24 ++++ man/simulatePlayoffs.Rd | 2 +- man/simulateSeasonParallel.Rd | 2 +- man/simulation_chunks.Rd | 23 ++++ man/single_series_solver.Rd | 2 +- man/todayDC.Rd | 2 +- man/todayOdds.Rd | 2 +- man/todayOddsPlot.Rd | 2 +- man/tweetGames.Rd | 2 +- man/tweetPlayoffOdds.Rd | 2 +- man/tweetSeries.Rd | 2 +- man/updateDC.Rd | 49 -------- man/updatePredictions.Rd | 2 +- tests/testthat/helper-pwhl.R | 2 +- tests/testthat/test-frontend-core.R | 4 +- tests/testthat/test-frontend-daily-summary.R | 2 +- tests/testthat/test-frontend-plots.R | 2 +- tests/testthat/test-nhl-dixon-coles-predict.R | 80 ++++++++---- .../testthat/test-nhl-dixon-coles-workflow.R | 6 +- tests/testthat/test-nhl-league-simulation.R | 4 +- tests/testthat/test-pwhl-daily-summary.R | 12 +- tests/testthat/test-pwhl-model-core.R | 20 +-- 72 files changed, 472 insertions(+), 285 deletions(-) delete mode 100644 man/dailyPWHLSummary.Rd create mode 100644 man/dcPredictVectorized.Rd create mode 100644 man/dcProbArray.Rd create mode 100644 man/dot-daily_summary_pwhl.Rd create mode 100644 man/dot-update_dc_nhl.Rd rename man/{updatePWHLDC.Rd => dot-update_dc_pwhl.Rd} (94%) rename man/{updatePWHLModel.Rd => dot-update_model_pwhl.Rd} (84%) create mode 100644 man/sim_batch.Rd create mode 100644 man/sim_odds_results.Rd create mode 100644 man/simulation_chunks.Rd delete mode 100644 man/updateDC.Rd diff --git a/NAMESPACE b/NAMESPACE index 661daaf8..4064d2e0 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -7,7 +7,6 @@ export(buildStats) export(cleanupPredictionsFile) export(colourDelta) export(compile_predictions) -export(dailyPWHLSummary) export(dailySummary) export(daily_odds_table) export(dcPredictMultipleDays) @@ -84,10 +83,7 @@ export(tweetMetrics) export(tweetPace) export(tweetPlayoffOdds) export(tweetSeries) -export(updateDC) export(updateModel) -export(updatePWHLDC) -export(updatePWHLModel) export(updatePWHLScheduleAPI) export(updatePWHLScoresAPI) export(updatePredictions) diff --git a/NEWS.md b/NEWS.md index 9e5ba20e..aa755832 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,6 @@ # HockeyModel 2026.0.1.9000 (development version) +* `updateModel()` and `dailySummary()` are now the single entry points for updating and summarising both leagues; the former league-specific exports `updateDC()`, `updatePWHLDC()`, `updatePWHLModel()`, and `dailyPWHLSummary()` are now internal (`.update_dc_nhl()`, `.update_dc_pwhl()`, `.update_model_pwhl()`, `.daily_summary_pwhl()`), and the `params` argument in the NHL prediction/simulation/social-media functions now documents the correct source of the params list (#42). * `simulateSeasonParallel()` no longer copies the invariant odds columns into the per-simulation score table on every iteration (the sampled outcome columns are built separately via a new internal `sim_odds_results()`), removing the redundant per-iteration data copying; its parallel branch now runs simulations in `cores` batched tasks (each worker handling several simulations) instead of one task per simulation, so the invariant table is serialised to each worker only `cores` times rather than `nsims` times (@pbulsink, #45). * `loopless_sim()`'s parallel branch now distributes exactly `nsims` simulations across `cores` chunks (remainder spread over the first `nsims %% cores` workers) via a new internal `simulation_chunks()` helper, instead of the previous `floor(nsims / cores)` per task that silently dropped the remainder and produced a total that rarely matched the requested `nsims` (@pbulsink, #51). * `simulateSeasonParallel()` and `loopless_sim()` parallel branches batch simulations into `cores` tasks (via `simulation_chunks()`) instead of one task per simulation, reducing serialisation round-trips across the worker cluster (@pbulsink, #49). diff --git a/R/data.R b/R/data.R index 1ea82fd3..0109353a 100644 --- a/R/data.R +++ b/R/data.R @@ -159,7 +159,7 @@ #' PWHL Dixon-Coles model `m` #' #' Fitted GLM capturing each PWHL team's attack and defence strength plus home -#' ice advantage. Populated by [updatePWHLDC()]. +#' ice advantage. Populated by [.update_dc_pwhl()]. #' #' @format a glm model fit, or `NULL` when not yet fitted "pwhl_m" @@ -168,7 +168,7 @@ #' PWHL Dixon-Coles `rho` #' #' Low-score correction parameter for the PWHL model. Populated by -#' [updatePWHLDC()]. +#' [.update_dc_pwhl()]. #' #' @format a single numeric value, or `NULL` when not yet fitted "pwhl_rho" @@ -177,7 +177,7 @@ #' PWHL `beta` #' #' Weibull shape parameter for PWHL tie-game enhancement. Populated by -#' [updatePWHLDC()]. +#' [.update_dc_pwhl()]. #' #' @format a single numeric value, or `NULL` when not yet fitted "pwhl_beta" @@ -186,7 +186,7 @@ #' PWHL `eta` #' #' Weibull scale parameter for PWHL tie-game enhancement. Populated by -#' [updatePWHLDC()]. +#' [.update_dc_pwhl()]. #' #' @format a single numeric value, or `NULL` when not yet fitted "pwhl_eta" @@ -195,7 +195,7 @@ #' PWHL `k` #' #' Weibull multiplier for PWHL tie-game enhancement. Populated by -#' [updatePWHLDC()]. +#' [.update_dc_pwhl()]. #' #' @format a single numeric value, or `NULL` when not yet fitted "pwhl_k" diff --git a/R/frontend-core.R b/R/frontend-core.R index e10da7a1..f43da219 100644 --- a/R/frontend-core.R +++ b/R/frontend-core.R @@ -157,7 +157,7 @@ cli::cli_inform("Updating Scores") scores <- updateScoresAPI(schedule = schedule, save_data = save_data) cli::cli_inform("Refitting Model Parameters") - params <- updateDC(scores = scores, save_data = save_data) + params <- .update_dc_nhl(scores = scores, save_data = save_data) list( scores = scores, schedule = schedule, @@ -185,7 +185,7 @@ updateModel <- function(save_data = TRUE, league = NULL) { result$nhl <- .update_model_nhl(save_data = save_data) } if ("PWHL" %in% leagues) { - result$pwhl <- updatePWHLModel(save_data = save_data) + result$pwhl <- .update_model_pwhl(save_data = save_data) } .simplify_frontend_result(result, leagues) @@ -281,7 +281,7 @@ updateModel <- function(save_data = TRUE, league = NULL) { #' @param data_dir directory of predictions #' @param scores HockeyModel::scores or a custom value #' @param schedule HockeyModel::schedule or a custom value -#' @param params The named list containing m, rho, beta, eta, and k. See [updateDC] for information on the params list +#' @param params The named list containing m, rho, beta, eta, and k. See [updateModel()] for information on the params list #' @param league which league front-end to run: `NULL`, `NA`, or `"both"` runs #' both leagues; `"nhl"` and `"pwhl"` run one league only #' diff --git a/R/frontend-daily-summary.R b/R/frontend-daily-summary.R index 78cb556c..9a46486f 100644 --- a/R/frontend-daily-summary.R +++ b/R/frontend-daily-summary.R @@ -42,7 +42,8 @@ today <- todayOddsPlot( params = params, schedule = modelparams$schedule, - scores = modelparams$scores, league = "NHL" + scores = modelparams$scores, + league = "NHL" ) # save to files. grDevices::png( @@ -320,7 +321,7 @@ dailySummary <- function( .default_pwhl_graphics_dir() ) } - result$pwhl <- dailyPWHLSummary( + result$pwhl <- .daily_summary_pwhl( graphic_dir = pwhl_graphic_dir, delay = delay ) diff --git a/R/frontend-plots.R b/R/frontend-plots.R index 85aa6f8b..b2da489f 100644 --- a/R/frontend-plots.R +++ b/R/frontend-plots.R @@ -72,7 +72,7 @@ #' Today's game odds graphic #' #' @param date date to predict odds. Default today -#' @param params The named list containing m, rho, beta, eta, and k. See [updateDC] for information on the params list +#' @param params The named list containing m, rho, beta, eta, and k. See [updateModel()] for information on the params list #' @param schedule HockeyModel::schedule or a custom value #' @param scores HockeyModel::scores or a custom value #' @param league which league front-end to run: `NULL`, `NA`, or `"both"` runs diff --git a/R/frontend-social.R b/R/frontend-social.R index 549adbf2..224b9e81 100644 --- a/R/frontend-social.R +++ b/R/frontend-social.R @@ -367,7 +367,7 @@ tweetLikelihoods <- function( #' @param games Games to tweet graphics from #' @param delay Delay between tweets #' @param graphic_dir the graphics directory -#' @param params The named list containing m, rho, beta, eta, and k. See [updateDC] for information on the params list +#' @param params The named list containing m, rho, beta, eta, and k. See [updateModel()] for information on the params list #' #' @returns (`data.frame`) A summary of each attempted post (see #' `.summarize_post_results()`), invisibly. @@ -475,7 +475,7 @@ tweetMetrics <- function() { #' @description Tweet the series odds graphics #' #' @param graphic_dir directory to save the image -#' @param params The named list containing m, rho, beta, eta, and k. See [updateDC] for information on the params list +#' @param params The named list containing m, rho, beta, eta, and k. See [updateModel()] for information on the params list #' @param delay Delay in seconds between posts. Default is a random value between 1 and 3 minutes. #' #' @return (`data.frame`) A summary of each attempted post (see @@ -563,7 +563,7 @@ tweetSeries <- function( #' @param summary_results the summary results file, otherwise the most recent will be loaded #' @param graphic_dir graphic dir #' @param trimcup trim to just cup winners -#' @param params The named list containing m, rho, beta, eta, and k. See [updateDC] for information on the params list +#' @param params The named list containing m, rho, beta, eta, and k. See [updateModel()] for information on the params list #' #' @return (`data.frame`) A summary of each attempted post (see #' `.summarize_post_results()`), invisibly. diff --git a/R/graphics-odds.R b/R/graphics-odds.R index 603f595e..4a2c5861 100644 --- a/R/graphics-odds.R +++ b/R/graphics-odds.R @@ -3,7 +3,7 @@ #' Plot Today's Odds #' #' @param today The day's odds to plot. Default today. -#' @param params The named list containing m, rho, beta, eta, and k. See [updateDC] for information on the params list +#' @param params The named list containing m, rho, beta, eta, and k. See [updateModel()] for information on the params list #' @param schedule HockeyModel::schedule or a custom value #' @param teamColours HockeyModel::teamColours or a custom value #' @param league League identifier. `"NHL"` (default) or `"PWHL"`. When @@ -207,7 +207,7 @@ plot_odds_today <- function( #' Plot Today's Playoff Series Odds #' #' @param series A data frame of home team, away team, home wins, away wins -#' @param params The named list containing m, rho, beta, eta, and k. See [updateDC] for information on the params list +#' @param params The named list containing m, rho, beta, eta, and k. See [updateModel()] for information on the params list #' @param teamColours HockeyModel::teamColours or a custom value #' @param league League identifier. `"NHL"` (default) or `"PWHL"`. When #' `"PWHL"`, PWHL-specific labels are used. diff --git a/R/graphics-plots.R b/R/graphics-plots.R index 8e91bd36..32f32210 100644 --- a/R/graphics-plots.R +++ b/R/graphics-plots.R @@ -4,7 +4,7 @@ #' #' @param home The Home Team #' @param away The Away Team -#' @param params The named list containing m, rho, beta, eta, and k. See [updateDC] for information on the params list +#' @param params The named list containing m, rho, beta, eta, and k. See [updateModel()] for information on the params list #' @param maxgoal the max number of goals to predict. Plot a few less. #' #' @return a ggplot object diff --git a/R/graphics-tables.R b/R/graphics-tables.R index ade9a0b3..96de5e51 100644 --- a/R/graphics-tables.R +++ b/R/graphics-tables.R @@ -182,7 +182,7 @@ format_playoff_odds <- function( #' @description Returns a gt table of odds for today's games (or games for a supplied date) #' #' @param today A date for games to create a table. Defaults to today. -#' @param params The named list containing m, rho, beta, eta, and k. See [updateDC] for information on the params list +#' @param params The named list containing m, rho, beta, eta, and k. See [updateModel()] for information on the params list #' @param schedule Schedule, or HockeyModel Schedule #' @param league League identifier. `"NHL"` (default) or `"PWHL"`. When #' `"PWHL"`, PWHL team colours and logos are used and the title is set to @@ -406,7 +406,7 @@ daily_odds_table <- function( #' AwayWins describing the current playoff series. Defaults to #' [getAPISeries()]. #' @param params The named list containing m, rho, beta, eta, and k. See -#' [updateDC] for information on the params list. +#' [updateModel()] for information on the params list. #' @param league League identifier. `"NHL"` (default) or `"PWHL"`. When #' `"PWHL"`, PWHL team colours and logos are used and the title is set to #' `"PWHL Playoff Series Odds"`. diff --git a/R/nhl-dixon-coles-predict.R b/R/nhl-dixon-coles-predict.R index fe3d18e1..93b1b15e 100644 --- a/R/nhl-dixon-coles-predict.R +++ b/R/nhl-dixon-coles-predict.R @@ -6,7 +6,7 @@ #' #' @param home home team #' @param away away team -#' @param params The named list containing m, rho, beta, eta, and k. See [updateDC] for information on the params list +#' @param params The named list containing m, rho, beta, eta, and k. See [updateModel()] for information on the params list #' @param maxgoal max number of goals per team #' @param scores optional, if not supplying m & rho, scores used to calculate them. #' @param expected_mean the mean lambda & mu, used only for regression @@ -81,7 +81,8 @@ dcProbArray <- function(lambda, mu, params, maxgoal) { idx0 <- 0:maxgoal # Weibull tie-enhancement on the diagonal (shared across games). - weib <- stats::dweibull(seq_len(G), shape = params$beta, scale = params$eta) * params$k + weib <- stats::dweibull(seq_len(G), shape = params$beta, scale = params$eta) * + params$k up <- upper.tri(matrix(1, G, G)) lo <- lower.tri(matrix(1, G, G)) @@ -113,7 +114,7 @@ dcProbArray <- function(lambda, mu, params, maxgoal) { out <- array(0, dim = c(G, G, n)) for (j in seq_len(n)) { - out[, , j] <- build_one(lambda[j], mu[j]) + out[,, j] <- build_one(lambda[j], mu[j]) } return(out) } @@ -151,40 +152,60 @@ dcPredictVectorized <- function( # Expected goals home / away per game, with the same error recovery path as # [dcLambda] so new or unseen teams still produce a numeric estimate. - lam <- vapply(seq_len(n), function(i) { - x <- try( - as.numeric(stats::predict( - params$m, - data.frame(Home = 1, Team = home[i], Opponent = away[i]), - type = "response" - )), - silent = TRUE - ) - if (is.numeric(x)) { - x - } else { - DCPredictErrorRecover(team = home[i], opponent = away[i], homeiceadv = TRUE) - } - }, numeric(1)) - mu <- vapply(seq_len(n), function(i) { - x <- try( - as.numeric(stats::predict( - params$m, - data.frame(Home = 0, Team = away[i], Opponent = home[i]), - type = "response" - )), - silent = TRUE - ) - if (is.numeric(x)) { - x - } else { - DCPredictErrorRecover(team = away[i], opponent = home[i], homeiceadv = FALSE) - } - }, numeric(1)) + lam <- vapply( + seq_len(n), + function(i) { + x <- try( + as.numeric(stats::predict( + params$m, + data.frame(Home = 1, Team = home[i], Opponent = away[i]), + type = "response" + )), + silent = TRUE + ) + if (is.numeric(x)) { + x + } else { + DCPredictErrorRecover( + team = home[i], + opponent = away[i], + homeiceadv = TRUE + ) + } + }, + numeric(1) + ) + mu <- vapply( + seq_len(n), + function(i) { + x <- try( + as.numeric(stats::predict( + params$m, + data.frame(Home = 0, Team = away[i], Opponent = home[i]), + type = "response" + )), + silent = TRUE + ) + if (is.numeric(x)) { + x + } else { + DCPredictErrorRecover( + team = away[i], + opponent = home[i], + homeiceadv = FALSE + ) + } + }, + numeric(1) + ) if (!is.null(expected_mean) && !is.null(season_percent)) { - lam <- lam * (1 - 1 / 3 * season_percent) + expected_mean * (1 / 3 * season_percent) - mu <- mu * (1 - 1 / 3 * season_percent) + expected_mean * (1 / 3 * season_percent) + lam <- lam * + (1 - 1 / 3 * season_percent) + + expected_mean * (1 / 3 * season_percent) + mu <- mu * + (1 - 1 / 3 * season_percent) + + expected_mean * (1 / 3 * season_percent) } pm <- dcProbArray(lambda = lam, mu = mu, params = params, maxgoal = maxgoal) @@ -203,7 +224,13 @@ dcPredictVectorized <- function( p2 <- h2 + a2 hw <- h2 / p2 aw <- a2 / p2 - return(matrix(c(hw, aw), nrow = n, ncol = 2, byrow = FALSE, dimnames = list(NULL, c("HomeWin", "AwayWin")))) + return(matrix( + c(hw, aw), + nrow = n, + ncol = 2, + byrow = FALSE, + dimnames = list(NULL, c("HomeWin", "AwayWin")) + )) } # Normalize each game's triple to sum to 1 (mirrors DCPredict's normalizeOdds). @@ -211,7 +238,13 @@ dcPredictVectorized <- function( hw <- hw / tot dw <- dw / tot aw <- aw / tot - return(matrix(c(hw, dw, aw), nrow = n, ncol = 3, byrow = FALSE, dimnames = list(NULL, c("HomeWin", "Draw", "AwayWin")))) + return(matrix( + c(hw, dw, aw), + nrow = n, + ncol = 3, + byrow = FALSE, + dimnames = list(NULL, c("HomeWin", "Draw", "AwayWin")) + )) } #' DC Expected Goals @@ -220,7 +253,7 @@ dcPredictVectorized <- function( #' #' @param home The home team name #' @param away The away team name -#' @param params The named list containing m, rho, beta, eta, and k. See [updateDC] for information on the params list +#' @param params The named list containing m, rho, beta, eta, and k. See [updateModel()] for information on the params list #' #' @return a list of $home and $away Poisson Lambda values - dcLambda <- function(home, away, params = NULL) { @@ -291,7 +324,7 @@ dcxG <- function(home, away, params = NULL, maxgoal = 10) { #' #' @param home home team #' @param away away team -#' @param params The named list containing m, rho, beta, eta, and k. See [updateDC] for information on the params list +#' @param params The named list containing m, rho, beta, eta, and k. See [updateModel()] for information on the params list #' @param maxgoal max number of goals per team #' @param scores optional, if not supplying m & rho, scores used to calculate them. #' @param expected_mean the mean lambda & mu, used only for regression @@ -341,7 +374,7 @@ dcProbMatrix <- function( #' #' @param lambda home lambda #' @param mu away mu -#' @param params The named list containing m, rho, beta, eta, and k. See [updateDC] for information on the params list +#' @param params The named list containing m, rho, beta, eta, and k. See [updateModel()] for information on the params list #' @param maxgoal max goals per game #' #' @return a square matrix of maxgoal:maxgoal, with all entries in `[0, 1]` and @@ -426,7 +459,7 @@ prob_matrix <- function(lambda, mu, params, maxgoal) { #' #' @param home home team #' @param away away team -#' @param params The named list containing m, rho, beta, eta, and k. See [updateDC] for information on the params list +#' @param params The named list containing m, rho, beta, eta, and k. See [updateModel()] for information on the params list #' @param maxgoal max number of goals per team #' @param scores optional, if not supplying m & rho, scores used to calculate them. #' @param expected_mean the mean lambda & mu, used only for regression @@ -507,7 +540,7 @@ dcSample <- function( #' #' @param lambda home team lambda #' @param mu away team mu -#' @param params The named list containing m, rho, beta, eta, and k. See [updateDC] for information on the params list +#' @param params The named list containing m, rho, beta, eta, and k. See [updateModel()] for information on the params list #' @param maxgoal max goals predicable per game, default 10 #' @param nsim the number of simulations in each result #' diff --git a/R/nhl-dixon-coles-workflow.R b/R/nhl-dixon-coles-workflow.R index e5e459a5..037a8367 100644 --- a/R/nhl-dixon-coles-workflow.R +++ b/R/nhl-dixon-coles-workflow.R @@ -1,16 +1,14 @@ # Dixon-Coles workflow: parameter updating, daily/playoff predictions, and season simulation orchestration -#' Update Dixon Coles parameters +#' Update NHL Dixon-Coles parameters #' -#' @description This function updates the model parameters to best fit the provided data. The parameters for this model are as follows: -#' * [m] is the result of the main model fit and contains team attack and defense strengths, plus home ice advantage terms -#' * [rho] is the Dixon-Coles low scores adjustment term. -#' * [beta] is the Weibull distribution's 'shape' parameter. This is used with [eta] to produce a curve multiplied by the diagonal score possibility matrix to enhance the odds of tie games -#' * [eta] is the Weibull distribution's 'scale' parameter. See above for its importance -#' * [k] is the multiplication factor used with the Weibull distribution to enhance ties +#' @description Fits the Dixon-Coles model to NHL scores data and returns (and +#' optionally saves) the five model parameters. #' -#' @param scores scores, if not then HockeyModel::scores is used -#' @param currentDate Current Date, usually today but useful to set a different date if back calculating results +#' @param scores (`data.frame`) NHL game scores. Defaults to +#' [HockeyModel::scores]. +#' @param currentDate (`Date`) Reference date for time-weighting. Defaults to +#' today. #' @param xi (`double(1)`) Logistic slope for within-season time-decay #' weighting. Defaults to [DC_XI_NHL]. #' @param upsilon (`double(1)`) Logistic midpoint (days) for within-season @@ -18,15 +16,12 @@ #' @param nu (`double(1)`) Cross-season discounting exponent. `0` (default #' [DC_NU_NHL]) disables cross-season discounting. See [DCweights()] for #' details. -#' @param save_data Whether to save parameters to the package. +#' @param save_data (`logical(1)`) If `TRUE` and `usethis` is installed, writes +#' the parameters as package data objects. #' -#' @return a named list containing m, rho, beta, eta and k values for the model. -#' -#' @seealso [m], [rho], [beta], [eta], [k], [DC_XI_NHL], [DC_UPSILON_NHL], -#' [DC_NU_NHL] -#' -#' @export -updateDC <- function( +#' @returns A named list with elements `m`, `rho`, `beta`, `eta`, and `k`. +#' @keywords internal +.update_dc_nhl <- function( scores = HockeyModel::scores, currentDate = Sys.Date(), xi = DC_XI_NHL, @@ -66,7 +61,7 @@ updateDC <- function( #' DC Predictions Today #' #' @param today Generate predictions for this date. Defaults to today -#' @param params The named list containing m, rho, beta, eta, and k. See [updateDC] for information on the params list +#' @param params The named list containing m, rho, beta, eta, and k. See [updateModel()] for information on the params list #' @param schedule schedule to use, if not the built-in #' @param expected_mean the mean lambda & mu, used only for regression #' @param season_percent the percent complete of the season, used for regression @@ -147,7 +142,7 @@ todayDC <- function( #' #' @param home Series Home Ice Advantage Team Name #' @param away Away (Opponent) Team Name -#' @param params The named list containing m, rho, beta, eta, and k. See [updateDC] for information on the params list +#' @param params The named list containing m, rho, beta, eta, and k. See [updateModel()] for information on the params list #' @param home_wins Number of wins for home ice advantage team thus far in series #' @param away_wins Number of wins for away team thus far in series #' @@ -176,7 +171,7 @@ playoffDC <- function(home, away, params = NULL, home_wins = 0, away_wins = 0) { #' @param odds whether to return odds table or simulate season #' @param regress whether to apply a regression to the mean for team strength on future predictions #' @param mu_lambda whether to return team xG values. Can't be set true if odds is true -#' @param params The named list containing m, rho, beta, eta, and k. See [updateDC] for information on the params list +#' @param params The named list containing m, rho, beta, eta, and k. See [updateModel()] for information on the params list #' #' @return data frame of Team, playoff odds. #' @export @@ -396,7 +391,7 @@ dcPredictMultipleDays <- function( score <- scores[scores$Date < day, ] score <- score[score$Date > as.Date("2008-08-01"), ] sched <- schedule[schedule$Date >= day, ] - params <- updateDC(scores = score, currentDate = d) + params <- .update_dc_nhl(scores = score, currentDate = d) preds <- NULL # preds <- loopless_sim(nsims = nsims, cores = cores, scores = score, schedule = sched, params = params, likelihood_graphic=likelihood_graphic) diff --git a/R/nhl-league-playoffs.R b/R/nhl-league-playoffs.R index 9b0742b1..d1f5c47d 100644 --- a/R/nhl-league-playoffs.R +++ b/R/nhl-league-playoffs.R @@ -7,7 +7,7 @@ #' @param away_team Opponent Team #' @param home_wins Home Ice Advantage Team Wins in Series #' @param away_wins Opponent Team Wins in Series -#' @param params The named list containing m, rho, beta, eta, and k. See [updateDC] for information on the params list +#' @param params The named list containing m, rho, beta, eta, and k. See [updateModel()] for information on the params list #' #' @return Odds from 0-1 of home team winning. Away odds are 1 - return value #' @export @@ -50,7 +50,7 @@ playoffWin <- function( #' @param home_wins Number of home wins (default 0) #' @param away_wins Number of away team wins (default 0) #' @param homeAwayOdds pre-calculated home & away team parings odds of a home win. Overrides playoffwin calculation -#' @param params The named list containing m, rho, beta, eta, and k. See [updateDC] for information on the params list +#' @param params The named list containing m, rho, beta, eta, and k. See [updateModel()] for information on the params list #' #' @return TRUE if the home team wins, else FALSE #' @export @@ -255,7 +255,7 @@ playoffSeriesOdds <- function( #' @param summary_results summary results #' @param nsims Number of playoff sims to run. Too many takes a long time. #' @param cores Number of processor cores to use -#' @param params The named list containing m, rho, beta, eta, and k. See [updateDC] for information on the params list +#' @param params The named list containing m, rho, beta, eta, and k. See [updateModel()] for information on the params list #' #' @return a data frame of each teams' odds of winning each round (First Round, Second Round, Conference Finals and Stanley Cup) #' @export @@ -517,7 +517,7 @@ reseedTwoTeams <- function(team1, team2, summary_results, p1 = NULL) { #' @param homeTeam Home Team extracted from summary_results #' @param awayTeam away Team extracted from summary_results #' @param homeAwayOdds if calculated, the odds of a home or away team win -#' @param params The named list containing m, rho, beta, eta, and k. See [updateDC] for information on the params list +#' @param params The named list containing m, rho, beta, eta, and k. See [updateModel()] for information on the params list #' #' @return a series winner (team name) single_series_solver <- function( @@ -631,7 +631,7 @@ getCompletedSeries <- function(currentSeries) { #' @param currentSeries currentSeries #' @param summary_results summary_results #' @param homeAwayOdds precalculated home & away pairs of odds - if available. -#' @param params The named list containing m, rho, beta, eta, and k. See [updateDC] for information on the params list +#' @param params The named list containing m, rho, beta, eta, and k. See [updateModel()] for information on the params list #' #' @export playoffSolverEngine <- function( @@ -1222,7 +1222,7 @@ playoffSolverEngine <- function( #' Get Series Odds #' -#' @param params The named list containing m, rho, beta, eta, and k. See [updateDC] for information on the params list +#' @param params The named list containing m, rho, beta, eta, and k. See [updateModel()] for information on the params list #' #' @return NULL if no series are currently set but not complete, else a data frame. #' @export diff --git a/R/nhl-league-predictions-log.R b/R/nhl-league-predictions-log.R index 30b80bf0..8fafc101 100644 --- a/R/nhl-league-predictions-log.R +++ b/R/nhl-league-predictions-log.R @@ -7,7 +7,7 @@ #' @param today Day's predictions to record. Defaults to today, but can set any other day #' @param filepath csv file location to store predictions. Will append to file. #' @param schedule HockeyModel::schedule or supplied. \code{today} date must be in schedule -#' @param params The named list containing m, rho, beta, eta, and k. See [updateDC] for information on the params list +#' @param params The named list containing m, rho, beta, eta, and k. See [updateModel()] for information on the params list #' @param include_xG Whether to record daily XG values #' @param draws whether to record draw odds (True) or not (False). Default is True #' diff --git a/R/nhl-league-simulation.R b/R/nhl-league-simulation.R index 3a5cf7af..f56e5508 100644 --- a/R/nhl-league-simulation.R +++ b/R/nhl-league-simulation.R @@ -27,7 +27,8 @@ sim_odds_results <- function(odds_table) { away_sos <- as.numeric(res2 > 0.6858606) away_ot <- as.numeric(res2 < 0.6858606) Result <- - 1 * (res1 < home_win) + + 1 * + (res1 < home_win) + 0.75 * in_ot * away_ot + 0.6 * in_ot * away_sos + 0.4 * in_so * away_sos + @@ -95,7 +96,7 @@ sim_batch <- function(sim_ids, odds_table, season_sofar = NULL) { #' @param nsims number of simulations to run #' @param cores number of cores to use in parallel. #' @param progress whether to show a progress bar. -#' @param params The named list containing m, rho, beta, eta, and k. See [updateDC] for information on the params list +#' @param params The named list containing m, rho, beta, eta, and k. See [updateModel()] for information on the params list #' #' @return a data frame of results #' @export @@ -160,7 +161,8 @@ simulateSeasonParallel <- function( away_sos <- as.numeric(res2 > 0.6858606) away_ot <- as.numeric(res2 < 0.6858606) Result <- - 1 * (res1 < home_win) + + 1 * + (res1 < home_win) + 0.75 * in_ot * away_ot + 0.6 * in_ot * away_sos + 0.4 * in_so * away_sos + @@ -275,7 +277,7 @@ compile_predictions <- function( #' @param cores number of cores in parallel to process #' @param schedule games to play #' @param scores Season to this point -#' @param params The named list containing m, rho, beta, eta, and k. See [updateDC] for information on the params list +#' @param params The named list containing m, rho, beta, eta, and k. See [updateModel()] for information on the params list #' @param season_sofar The results of the season to date #' @param likelihood_graphic whether to create a likelihood graphic #' @param odds_table a table of odds for all games in schedule. Null, unless provided. Should be similar to the output of `remainderSeasonDC(odds=TRUE)`, @@ -444,7 +446,7 @@ loopless_sim <- function( #' #' @param all_season One seasons' scores & odds schedule #' @param nsims Number of simulations to run -#' @param params The named list containing m, rho, beta, eta, and k. See [updateDC] for information on the params list +#' @param params The named list containing m, rho, beta, eta, and k. See [updateModel()] for information on the params list #' #' @return results of `nsims` season simulations, as one long data frame score table. #' @export @@ -638,7 +640,7 @@ sim_engine <- function(all_season, nsims, params = NULL) { #' Today's Odds #' #' @description Determine today's games' odds (if today has games), or a specified date's odds -#' @param params The named list containing m, rho, beta, eta, and k. See [updateDC] for information on the params list +#' @param params The named list containing m, rho, beta, eta, and k. See [updateModel()] for information on the params list #' @param today The date for which you want game odds #' @param schedule The schedule, default to internal schedule #' @param expected_mean the mean lambda & mu, used only for regression diff --git a/R/pwhl-daily-summary.R b/R/pwhl-daily-summary.R index f9fae4e9..a8f2ac3b 100644 --- a/R/pwhl-daily-summary.R +++ b/R/pwhl-daily-summary.R @@ -2,21 +2,13 @@ #' Daily PWHL summary — update, predict, and post #' -#' @description The PWHL equivalent of [dailySummary()]. Fetches the latest +#' @description The PWHL branch of [dailySummary()]. Fetches the latest #' schedule and scores, re-fits the Dixon-Coles model, generates graphics for #' today's games and season-wide predictions, and optionally posts them to #' social media via [atrrr::post()]. #' -#' Running `dailyPWHLSummary()` with no arguments performs the full daily -#' workflow using the package's stored PWHL datasets. -#' -#' @param graphic_dir (`character(1)`) Directory to save generated PNG files. -#' @param delay (`double(1)`) Seconds to wait between social-media posts. -#' -#' @returns (`data.frame`) A summary of every attempted social post (see -#' `.summarize_post_results()` in `frontend-social.R`), invisibly. -#' @export -dailyPWHLSummary <- function( +#' @keywords internal +.daily_summary_pwhl <- function( graphic_dir = file.path( getOption("HockeyModel.prediction.path", "./prediction_results"), "pwhl_graphics" @@ -24,7 +16,7 @@ dailyPWHLSummary <- function( delay = stats::runif(1, min = 2, max = 6) * 60 ) { post_results <- list() - model_data <- updatePWHLModel() + model_data <- .update_model_pwhl() schedule <- model_data$schedule scores <- model_data$scores params <- parse_pwhl_dc_params(model_data$params) diff --git a/R/pwhl-model-core.R b/R/pwhl-model-core.R index 74e19452..fd39645a 100644 --- a/R/pwhl-model-core.R +++ b/R/pwhl-model-core.R @@ -48,8 +48,8 @@ pwhl_add_result <- function(scores) { #' the parameters as package data objects. #' #' @returns A named list with elements `m`, `rho`, `beta`, `eta`, and `k`. -#' @export -updatePWHLDC <- function( +#' @keywords internal +.update_dc_pwhl <- function( scores = HockeyModel::pwhlScores, currentDate = Sys.Date(), xi = DC_XI_PWHL, @@ -153,8 +153,8 @@ parse_pwhl_dc_params <- function(params = NULL) { #' model parameters as package data. #' #' @returns A named list with elements `scores`, `schedule`, and `params`. -#' @export -updatePWHLModel <- function(save_data = TRUE) { +#' @keywords internal +.update_model_pwhl <- function(save_data = TRUE) { cli::cli_inform("Updating PWHL Schedule") schedule <- updatePWHLScheduleAPI(save_data = save_data) @@ -165,7 +165,7 @@ updatePWHLModel <- function(save_data = TRUE) { ) cli::cli_inform("Refitting PWHL Model Parameters") - params <- updatePWHLDC(scores = scores, save_data = save_data) + params <- .update_dc_pwhl(scores = scores, save_data = save_data) list( scores = scores, diff --git a/man/DCPredict.Rd b/man/DCPredict.Rd index 52698697..7c38b6d4 100644 --- a/man/DCPredict.Rd +++ b/man/DCPredict.Rd @@ -20,7 +20,7 @@ DCPredict( \item{away}{away team} -\item{params}{The named list containing m, rho, beta, eta, and k. See \link{updateDC} for information on the params list} +\item{params}{The named list containing m, rho, beta, eta, and k. See \code{\link[=updateModel]{updateModel()}} for information on the params list} \item{maxgoal}{max number of goals per team} diff --git a/man/dailyPWHLSummary.Rd b/man/dailyPWHLSummary.Rd deleted file mode 100644 index a633650b..00000000 --- a/man/dailyPWHLSummary.Rd +++ /dev/null @@ -1,30 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/pwhl-daily-summary.R -\name{dailyPWHLSummary} -\alias{dailyPWHLSummary} -\title{Daily PWHL summary — update, predict, and post} -\usage{ -dailyPWHLSummary( - graphic_dir = file.path(getOption("HockeyModel.prediction.path", - "./prediction_results"), "pwhl_graphics"), - delay = stats::runif(1, min = 2, max = 6) * 60 -) -} -\arguments{ -\item{graphic_dir}{(\code{character(1)}) Directory to save generated PNG files.} - -\item{delay}{(\code{double(1)}) Seconds to wait between social-media posts.} -} -\value{ -(\code{data.frame}) A summary of every attempted social post (see -\code{.summarize_post_results()} in \code{frontend-social.R}), invisibly. -} -\description{ -The PWHL equivalent of \code{\link[=dailySummary]{dailySummary()}}. Fetches the latest -schedule and scores, re-fits the Dixon-Coles model, generates graphics for -today's games and season-wide predictions, and optionally posts them to -social media via \code{\link[atrrr:post]{atrrr::post()}}. - -Running \code{dailyPWHLSummary()} with no arguments performs the full daily -workflow using the package's stored PWHL datasets. -} diff --git a/man/daily_odds_table.Rd b/man/daily_odds_table.Rd index 60e065c8..bf5d845a 100644 --- a/man/daily_odds_table.Rd +++ b/man/daily_odds_table.Rd @@ -14,7 +14,7 @@ daily_odds_table( \arguments{ \item{today}{A date for games to create a table. Defaults to today.} -\item{params}{The named list containing m, rho, beta, eta, and k. See \link{updateDC} for information on the params list} +\item{params}{The named list containing m, rho, beta, eta, and k. See \code{\link[=updateModel]{updateModel()}} for information on the params list} \item{schedule}{Schedule, or HockeyModel Schedule} diff --git a/man/dcLambda.Rd b/man/dcLambda.Rd index 15f7afbc..b55806d2 100644 --- a/man/dcLambda.Rd +++ b/man/dcLambda.Rd @@ -11,7 +11,7 @@ dcLambda(home, away, params = NULL) \item{away}{The away team name} -\item{params}{The named list containing m, rho, beta, eta, and k. See \link{updateDC} for information on the params list} +\item{params}{The named list containing m, rho, beta, eta, and k. See \code{\link[=updateModel]{updateModel()}} for information on the params list} } \value{ a list of $home and $away Poisson Lambda values - diff --git a/man/dcPredictVectorized.Rd b/man/dcPredictVectorized.Rd new file mode 100644 index 00000000..e2ae0d9d --- /dev/null +++ b/man/dcPredictVectorized.Rd @@ -0,0 +1,44 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/nhl-dixon-coles-predict.R +\name{dcPredictVectorized} +\alias{dcPredictVectorized} +\title{Vectorized Dixon-Coles odds} +\usage{ +dcPredictVectorized( + home, + away, + params = NULL, + maxgoal = 10, + expected_mean = NULL, + season_percent = NULL, + draws = TRUE +) +} +\arguments{ +\item{home}{(\code{character(n)}) Home team name per game.} + +\item{away}{(\code{character(n)}) Away team name per game.} + +\item{params}{(\code{list}) Dixon-Coles parameter list (m, rho, beta, eta, k).} + +\item{maxgoal}{(\code{integer(1)}) Maximum goals per team.} + +\item{expected_mean}{(\code{double} or \code{NULL}) Mean lambda/mu for regression.} + +\item{season_percent}{(\code{double} or \code{NULL}) Season completion fraction for +regression.} + +\item{draws}{(\code{logical(1)}) Whether to return a 3-column (home, draw, away) +matrix; if \code{FALSE}, returns a 2-column (home, away) matrix with the draw +probability distributed proportionally.} +} +\value{ +(\verb{matrix(n x 3)} or \verb{matrix(n x 2)}) Probability columns. +} +\description{ +Computes home/draw/away win probabilities for many games at +once. The output is statistically identical to calling \link{DCPredict} +per game, but avoids the per-game function-call overhead that makes +\code{todayDC()} / \code{remainderSeasonDC()} O(F) in function calls. +} +\keyword{internal} diff --git a/man/dcProbArray.Rd b/man/dcProbArray.Rd new file mode 100644 index 00000000..266d0056 --- /dev/null +++ b/man/dcProbArray.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/nhl-dixon-coles-predict.R +\name{dcProbArray} +\alias{dcProbArray} +\title{Vectorized Dixon-Coles probability array} +\usage{ +dcProbArray(lambda, mu, params, maxgoal) +} +\arguments{ +\item{lambda}{(\code{double(n)}) Home expected goals, one value per game.} + +\item{mu}{(\code{double(n)}) Away expected goals, one value per game.} + +\item{params}{(\code{list}) Dixon-Coles parameter list (m, rho, beta, eta, k).} + +\item{maxgoal}{(\code{integer(1)}) Maximum goals per team.} +} +\value{ +(\code{array}) Probability array of dim \verb{(maxgoal+1) x (maxgoal+1) x n}. +} +\description{ +Builds the Dixon-Coles probability matrix for each of many +(lambda, mu) pairs at once, returning a 3D array of dimension +\verb{(maxgoal+1) x (maxgoal+1) x n}. Each slice \code{pm[,,j]} is exactly what +\link{prob_matrix} returns for the j-th game, so the per-game output is +statistically identical to the scalar path. +} +\keyword{internal} diff --git a/man/dcProbMatrix.Rd b/man/dcProbMatrix.Rd index 4c2cf542..84a1151a 100644 --- a/man/dcProbMatrix.Rd +++ b/man/dcProbMatrix.Rd @@ -19,7 +19,7 @@ dcProbMatrix( \item{away}{away team} -\item{params}{The named list containing m, rho, beta, eta, and k. See \link{updateDC} for information on the params list} +\item{params}{The named list containing m, rho, beta, eta, and k. See \code{\link[=updateModel]{updateModel()}} for information on the params list} \item{maxgoal}{max number of goals per team} diff --git a/man/dcResult.Rd b/man/dcResult.Rd index 8eb3635d..ea9431ac 100644 --- a/man/dcResult.Rd +++ b/man/dcResult.Rd @@ -11,7 +11,7 @@ dcResult(lambda, mu, params = NULL, maxgoal = 8, nsim = 1) \item{mu}{away team mu} -\item{params}{The named list containing m, rho, beta, eta, and k. See \link{updateDC} for information on the params list} +\item{params}{The named list containing m, rho, beta, eta, and k. See \code{\link[=updateModel]{updateModel()}} for information on the params list} \item{maxgoal}{max goals predicable per game, default 10} diff --git a/man/dcSample.Rd b/man/dcSample.Rd index 5c1ccab5..ff27ce2d 100644 --- a/man/dcSample.Rd +++ b/man/dcSample.Rd @@ -20,7 +20,7 @@ dcSample( \item{away}{away team} -\item{params}{The named list containing m, rho, beta, eta, and k. See \link{updateDC} for information on the params list} +\item{params}{The named list containing m, rho, beta, eta, and k. See \code{\link[=updateModel]{updateModel()}} for information on the params list} \item{maxgoal}{max number of goals per team} diff --git a/man/dot-daily_summary_pwhl.Rd b/man/dot-daily_summary_pwhl.Rd new file mode 100644 index 00000000..f6018d6e --- /dev/null +++ b/man/dot-daily_summary_pwhl.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/pwhl-daily-summary.R +\name{.daily_summary_pwhl} +\alias{.daily_summary_pwhl} +\title{Daily PWHL summary — update, predict, and post} +\usage{ +.daily_summary_pwhl( + graphic_dir = file.path(getOption("HockeyModel.prediction.path", + "./prediction_results"), "pwhl_graphics"), + delay = stats::runif(1, min = 2, max = 6) * 60 +) +} +\description{ +The PWHL branch of \code{\link[=dailySummary]{dailySummary()}}. Fetches the latest +schedule and scores, re-fits the Dixon-Coles model, generates graphics for +today's games and season-wide predictions, and optionally posts them to +social media via \code{\link[atrrr:post]{atrrr::post()}}. +} +\keyword{internal} diff --git a/man/dot-update_dc_nhl.Rd b/man/dot-update_dc_nhl.Rd new file mode 100644 index 00000000..27a454fb --- /dev/null +++ b/man/dot-update_dc_nhl.Rd @@ -0,0 +1,43 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/nhl-dixon-coles-workflow.R +\name{.update_dc_nhl} +\alias{.update_dc_nhl} +\title{Update NHL Dixon-Coles parameters} +\usage{ +.update_dc_nhl( + scores = HockeyModel::scores, + currentDate = Sys.Date(), + xi = DC_XI_NHL, + upsilon = DC_UPSILON_NHL, + nu = DC_NU_NHL, + save_data = TRUE +) +} +\arguments{ +\item{scores}{(\code{data.frame}) NHL game scores. Defaults to +\link{scores}.} + +\item{currentDate}{(\code{Date}) Reference date for time-weighting. Defaults to +today.} + +\item{xi}{(\code{double(1)}) Logistic slope for within-season time-decay +weighting. Defaults to \link{DC_XI_NHL}.} + +\item{upsilon}{(\code{double(1)}) Logistic midpoint (days) for within-season +time-decay weighting. Defaults to \link{DC_UPSILON_NHL}.} + +\item{nu}{(\code{double(1)}) Cross-season discounting exponent. \code{0} (default +\link{DC_NU_NHL}) disables cross-season discounting. See \code{\link[=DCweights]{DCweights()}} for +details.} + +\item{save_data}{(\code{logical(1)}) If \code{TRUE} and \code{usethis} is installed, writes +the parameters as package data objects.} +} +\value{ +A named list with elements \code{m}, \code{rho}, \code{beta}, \code{eta}, and \code{k}. +} +\description{ +Fits the Dixon-Coles model to NHL scores data and returns (and +optionally saves) the five model parameters. +} +\keyword{internal} diff --git a/man/updatePWHLDC.Rd b/man/dot-update_dc_pwhl.Rd similarity index 94% rename from man/updatePWHLDC.Rd rename to man/dot-update_dc_pwhl.Rd index 2eb7ed60..b02bb430 100644 --- a/man/updatePWHLDC.Rd +++ b/man/dot-update_dc_pwhl.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/pwhl-model-core.R -\name{updatePWHLDC} -\alias{updatePWHLDC} +\name{.update_dc_pwhl} +\alias{.update_dc_pwhl} \title{Update PWHL Dixon-Coles parameters} \usage{ -updatePWHLDC( +.update_dc_pwhl( scores = HockeyModel::pwhlScores, currentDate = Sys.Date(), xi = DC_XI_PWHL, @@ -42,3 +42,4 @@ Fits the Dixon-Coles model to PWHL scores data and returns (and optionally saves) the five model parameters: \code{pwhl_m}, \code{pwhl_rho}, \code{pwhl_beta}, \code{pwhl_eta}, and \code{pwhl_k}. } +\keyword{internal} diff --git a/man/updatePWHLModel.Rd b/man/dot-update_model_pwhl.Rd similarity index 84% rename from man/updatePWHLModel.Rd rename to man/dot-update_model_pwhl.Rd index 68104635..43dddffb 100644 --- a/man/updatePWHLModel.Rd +++ b/man/dot-update_model_pwhl.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/pwhl-model-core.R -\name{updatePWHLModel} -\alias{updatePWHLModel} +\name{.update_model_pwhl} +\alias{.update_model_pwhl} \title{Update the PWHL model} \usage{ -updatePWHLModel(save_data = TRUE) +.update_model_pwhl(save_data = TRUE) } \arguments{ \item{save_data}{(\code{logical(1)}) Whether to persist the updated data and @@ -18,3 +18,4 @@ Fetches the latest PWHL schedule and scores then re-fits the Dixon-Coles model parameters. Returns a list with \code{scores}, \code{schedule}, and \code{params} — the same shape as \code{\link[=updateModel]{updateModel()}}. } +\keyword{internal} diff --git a/man/getSeriesOdds.Rd b/man/getSeriesOdds.Rd index 60e3eff2..0cf1cdc0 100644 --- a/man/getSeriesOdds.Rd +++ b/man/getSeriesOdds.Rd @@ -7,7 +7,7 @@ getSeriesOdds(params = NULL) } \arguments{ -\item{params}{The named list containing m, rho, beta, eta, and k. See \link{updateDC} for information on the params list} +\item{params}{The named list containing m, rho, beta, eta, and k. See \code{\link[=updateModel]{updateModel()}} for information on the params list} } \value{ NULL if no series are currently set but not complete, else a data frame. diff --git a/man/loopless_sim.Rd b/man/loopless_sim.Rd index 43b21584..317416c6 100644 --- a/man/loopless_sim.Rd +++ b/man/loopless_sim.Rd @@ -24,7 +24,7 @@ loopless_sim( \item{scores}{Season to this point} -\item{params}{The named list containing m, rho, beta, eta, and k. See \link{updateDC} for information on the params list} +\item{params}{The named list containing m, rho, beta, eta, and k. See \code{\link[=updateModel]{updateModel()}} for information on the params list} \item{season_sofar}{The results of the season to date} diff --git a/man/playoffDC.Rd b/man/playoffDC.Rd index 7eee2e5a..73f4c71e 100644 --- a/man/playoffDC.Rd +++ b/man/playoffDC.Rd @@ -11,7 +11,7 @@ playoffDC(home, away, params = NULL, home_wins = 0, away_wins = 0) \item{away}{Away (Opponent) Team Name} -\item{params}{The named list containing m, rho, beta, eta, and k. See \link{updateDC} for information on the params list} +\item{params}{The named list containing m, rho, beta, eta, and k. See \code{\link[=updateModel]{updateModel()}} for information on the params list} \item{home_wins}{Number of wins for home ice advantage team thus far in series} diff --git a/man/playoffSolverEngine.Rd b/man/playoffSolverEngine.Rd index 81242ef2..4467791f 100644 --- a/man/playoffSolverEngine.Rd +++ b/man/playoffSolverEngine.Rd @@ -30,7 +30,7 @@ playoffSolverEngine( \item{homeAwayOdds}{precalculated home & away pairs of odds - if available.} -\item{params}{The named list containing m, rho, beta, eta, and k. See \link{updateDC} for information on the params list} +\item{params}{The named list containing m, rho, beta, eta, and k. See \code{\link[=updateModel]{updateModel()}} for information on the params list} } \description{ Does the actual simulating. A function so it's parallelizable. Not to be called directly. Exported for parallel's use diff --git a/man/playoffWin.Rd b/man/playoffWin.Rd index e4d72f00..4ead22ab 100644 --- a/man/playoffWin.Rd +++ b/man/playoffWin.Rd @@ -15,7 +15,7 @@ playoffWin(home_team, away_team, home_wins = 0, away_wins = 0, params = NULL) \item{away_wins}{Opponent Team Wins in Series} -\item{params}{The named list containing m, rho, beta, eta, and k. See \link{updateDC} for information on the params list} +\item{params}{The named list containing m, rho, beta, eta, and k. See \code{\link[=updateModel]{updateModel()}} for information on the params list} } \value{ Odds from 0-1 of home team winning. Away odds are 1 - return value diff --git a/man/plot_game.Rd b/man/plot_game.Rd index 44620810..cbe9bc22 100644 --- a/man/plot_game.Rd +++ b/man/plot_game.Rd @@ -11,7 +11,7 @@ plot_game(home, away, params = NULL, maxgoal = 10) \item{away}{The Away Team} -\item{params}{The named list containing m, rho, beta, eta, and k. See \link{updateDC} for information on the params list} +\item{params}{The named list containing m, rho, beta, eta, and k. See \code{\link[=updateModel]{updateModel()}} for information on the params list} \item{maxgoal}{the max number of goals to predict. Plot a few less.} } diff --git a/man/plot_odds_today.Rd b/man/plot_odds_today.Rd index cda11282..cdad40d4 100644 --- a/man/plot_odds_today.Rd +++ b/man/plot_odds_today.Rd @@ -15,7 +15,7 @@ plot_odds_today( \arguments{ \item{today}{The day's odds to plot. Default today.} -\item{params}{The named list containing m, rho, beta, eta, and k. See \link{updateDC} for information on the params list} +\item{params}{The named list containing m, rho, beta, eta, and k. See \code{\link[=updateModel]{updateModel()}} for information on the params list} \item{schedule}{HockeyModel::schedule or a custom value} diff --git a/man/plot_playoff_series_odds.Rd b/man/plot_playoff_series_odds.Rd index 44d21b49..617ed032 100644 --- a/man/plot_playoff_series_odds.Rd +++ b/man/plot_playoff_series_odds.Rd @@ -14,7 +14,7 @@ plot_playoff_series_odds( \arguments{ \item{series}{A data frame of home team, away team, home wins, away wins} -\item{params}{The named list containing m, rho, beta, eta, and k. See \link{updateDC} for information on the params list} +\item{params}{The named list containing m, rho, beta, eta, and k. See \code{\link[=updateModel]{updateModel()}} for information on the params list} \item{teamColours}{HockeyModel::teamColours or a custom value} diff --git a/man/prob_matrix.Rd b/man/prob_matrix.Rd index 4b4f2e30..412c3189 100644 --- a/man/prob_matrix.Rd +++ b/man/prob_matrix.Rd @@ -11,7 +11,7 @@ prob_matrix(lambda, mu, params, maxgoal) \item{mu}{away mu} -\item{params}{The named list containing m, rho, beta, eta, and k. See \link{updateDC} for information on the params list} +\item{params}{The named list containing m, rho, beta, eta, and k. See \code{\link[=updateModel]{updateModel()}} for information on the params list} \item{maxgoal}{max goals per game} } diff --git a/man/pwhl_beta.Rd b/man/pwhl_beta.Rd index 0b8c5d4e..99948c20 100644 --- a/man/pwhl_beta.Rd +++ b/man/pwhl_beta.Rd @@ -12,6 +12,6 @@ pwhl_beta } \description{ Weibull shape parameter for PWHL tie-game enhancement. Populated by -\code{\link[=updatePWHLDC]{updatePWHLDC()}}. +\code{\link[=.update_dc_pwhl]{.update_dc_pwhl()}}. } \keyword{datasets} diff --git a/man/pwhl_eta.Rd b/man/pwhl_eta.Rd index 54465c31..d0501158 100644 --- a/man/pwhl_eta.Rd +++ b/man/pwhl_eta.Rd @@ -12,6 +12,6 @@ pwhl_eta } \description{ Weibull scale parameter for PWHL tie-game enhancement. Populated by -\code{\link[=updatePWHLDC]{updatePWHLDC()}}. +\code{\link[=.update_dc_pwhl]{.update_dc_pwhl()}}. } \keyword{datasets} diff --git a/man/pwhl_k.Rd b/man/pwhl_k.Rd index 8d064dc2..b721b993 100644 --- a/man/pwhl_k.Rd +++ b/man/pwhl_k.Rd @@ -12,6 +12,6 @@ pwhl_k } \description{ Weibull multiplier for PWHL tie-game enhancement. Populated by -\code{\link[=updatePWHLDC]{updatePWHLDC()}}. +\code{\link[=.update_dc_pwhl]{.update_dc_pwhl()}}. } \keyword{datasets} diff --git a/man/pwhl_m.Rd b/man/pwhl_m.Rd index 9dacf9dc..53768b97 100644 --- a/man/pwhl_m.Rd +++ b/man/pwhl_m.Rd @@ -12,6 +12,6 @@ pwhl_m } \description{ Fitted GLM capturing each PWHL team's attack and defence strength plus home -ice advantage. Populated by \code{\link[=updatePWHLDC]{updatePWHLDC()}}. +ice advantage. Populated by \code{\link[=.update_dc_pwhl]{.update_dc_pwhl()}}. } \keyword{datasets} diff --git a/man/pwhl_rho.Rd b/man/pwhl_rho.Rd index feec5274..efab5a1c 100644 --- a/man/pwhl_rho.Rd +++ b/man/pwhl_rho.Rd @@ -12,6 +12,6 @@ pwhl_rho } \description{ Low-score correction parameter for the PWHL model. Populated by -\code{\link[=updatePWHLDC]{updatePWHLDC()}}. +\code{\link[=.update_dc_pwhl]{.update_dc_pwhl()}}. } \keyword{datasets} diff --git a/man/randomSeriesWinner.Rd b/man/randomSeriesWinner.Rd index b1ae3e62..bdd720ef 100644 --- a/man/randomSeriesWinner.Rd +++ b/man/randomSeriesWinner.Rd @@ -24,7 +24,7 @@ randomSeriesWinner( \item{homeAwayOdds}{pre-calculated home & away team parings odds of a home win. Overrides playoffwin calculation} -\item{params}{The named list containing m, rho, beta, eta, and k. See \link{updateDC} for information on the params list} +\item{params}{The named list containing m, rho, beta, eta, and k. See \code{\link[=updateModel]{updateModel()}} for information on the params list} } \value{ TRUE if the home team wins, else FALSE diff --git a/man/recordTodaysPredictions.Rd b/man/recordTodaysPredictions.Rd index a334a602..657c3d85 100644 --- a/man/recordTodaysPredictions.Rd +++ b/man/recordTodaysPredictions.Rd @@ -20,7 +20,7 @@ recordTodaysPredictions( \item{schedule}{HockeyModel::schedule or supplied. \code{today} date must be in schedule} -\item{params}{The named list containing m, rho, beta, eta, and k. See \link{updateDC} for information on the params list} +\item{params}{The named list containing m, rho, beta, eta, and k. See \code{\link[=updateModel]{updateModel()}} for information on the params list} \item{include_xG}{Whether to record daily XG values} diff --git a/man/remainderSeasonDC.Rd b/man/remainderSeasonDC.Rd index cd5cd4f4..6f8a8401 100644 --- a/man/remainderSeasonDC.Rd +++ b/man/remainderSeasonDC.Rd @@ -20,7 +20,7 @@ remainderSeasonDC( \item{cores}{The number of cores to use if using parallel processing, or 1 for single-core, NULL defaults to all cores or 1 if \code{parallel} package not installed.} -\item{params}{The named list containing m, rho, beta, eta, and k. See \link{updateDC} for information on the params list} +\item{params}{The named list containing m, rho, beta, eta, and k. See \code{\link[=updateModel]{updateModel()}} for information on the params list} \item{scores}{the historical scores} diff --git a/man/series_odds_table.Rd b/man/series_odds_table.Rd index d18c1d1e..1a6925b1 100644 --- a/man/series_odds_table.Rd +++ b/man/series_odds_table.Rd @@ -12,7 +12,7 @@ AwayWins describing the current playoff series. Defaults to \code{\link[=getAPISeries]{getAPISeries()}}.} \item{params}{The named list containing m, rho, beta, eta, and k. See -\link{updateDC} for information on the params list.} +\code{\link[=updateModel]{updateModel()}} for information on the params list.} \item{league}{League identifier. \code{"NHL"} (default) or \code{"PWHL"}. When \code{"PWHL"}, PWHL team colours and logos are used and the title is set to diff --git a/man/sim_batch.Rd b/man/sim_batch.Rd new file mode 100644 index 00000000..640ce0a6 --- /dev/null +++ b/man/sim_batch.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/nhl-league-simulation.R +\name{sim_batch} +\alias{sim_batch} +\title{Build the per-team stats table for a batch of simulations} +\usage{ +sim_batch(sim_ids, odds_table, season_sofar = NULL) +} +\arguments{ +\item{sim_ids}{(\code{integer}) Simulation numbers to assign to each built table.} + +\item{odds_table}{(\code{data.frame}) Odds table with \code{HomeTeam}, \code{AwayTeam}, +\code{Date}, \code{GameID}, \code{HomeWin}, \code{HOT}, \code{AOT}.} + +\item{season_sofar}{(\code{data.frame} or \code{NULL}) Past (played) season scores with +\code{Date}, \code{HomeTeam}, \code{AwayTeam}, \code{Result}; prepended to every simulation.} +} +\value{ +(\code{tibble}) Per-team stats with a \code{SimNo} column, one block per +simulation in \code{sim_ids}. +} +\description{ +Runs \code{length(sim_ids)} simulations (one per element of +\code{sim_ids}) against \code{odds_table}, building the per-team standings for each +and tagging them with their simulation number. Lives at package level (not +a closure) so it is visible to \code{parallel}/\code{doSNOW} workers, which only see +the package's attached environment. +} +\keyword{internal} diff --git a/man/sim_engine.Rd b/man/sim_engine.Rd index 0a76a4b3..be15c95a 100644 --- a/man/sim_engine.Rd +++ b/man/sim_engine.Rd @@ -11,7 +11,7 @@ sim_engine(all_season, nsims, params = NULL) \item{nsims}{Number of simulations to run} -\item{params}{The named list containing m, rho, beta, eta, and k. See \link{updateDC} for information on the params list} +\item{params}{The named list containing m, rho, beta, eta, and k. See \code{\link[=updateModel]{updateModel()}} for information on the params list} } \value{ results of \code{nsims} season simulations, as one long data frame score table. diff --git a/man/sim_odds_results.Rd b/man/sim_odds_results.Rd new file mode 100644 index 00000000..1a39455f --- /dev/null +++ b/man/sim_odds_results.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/nhl-league-simulation.R +\name{sim_odds_results} +\alias{sim_odds_results} +\title{Sample simulated results for odds-table games} +\usage{ +sim_odds_results(odds_table) +} +\arguments{ +\item{odds_table}{(\code{data.frame}) Odds table with \code{HomeWin}, \code{HOT}, \code{AOT} +(and any other columns). Used for its row count and the per-game odds.} +} +\value{ +\verb{list(res1 = , res2 = , Result = )} each of +length \code{nrow(odds_table)}. +} +\description{ +Draws the regulation/OT/SO outcome for every game in \code{odds_table} +(\code{nrow(odds_table)} times, i.e. one outcome per simulation) using the +two-draw \code{res1}/\code{res2} scheme. Only the sampled columns are built here; the +invariant odds columns are not copied, so callers can reuse the same +\code{odds_table} across simulations without re-copying it each iteration. +} +\keyword{internal} diff --git a/man/simulatePlayoffs.Rd b/man/simulatePlayoffs.Rd index c3d54bd1..e303e0ca 100644 --- a/man/simulatePlayoffs.Rd +++ b/man/simulatePlayoffs.Rd @@ -18,7 +18,7 @@ simulatePlayoffs( \item{cores}{Number of processor cores to use} -\item{params}{The named list containing m, rho, beta, eta, and k. See \link{updateDC} for information on the params list} +\item{params}{The named list containing m, rho, beta, eta, and k. See \code{\link[=updateModel]{updateModel()}} for information on the params list} } \value{ a data frame of each teams' odds of winning each round (First Round, Second Round, Conference Finals and Stanley Cup) diff --git a/man/simulateSeasonParallel.Rd b/man/simulateSeasonParallel.Rd index 40dae531..f55d8517 100644 --- a/man/simulateSeasonParallel.Rd +++ b/man/simulateSeasonParallel.Rd @@ -24,7 +24,7 @@ simulateSeasonParallel( \item{progress}{whether to show a progress bar.} -\item{params}{The named list containing m, rho, beta, eta, and k. See \link{updateDC} for information on the params list} +\item{params}{The named list containing m, rho, beta, eta, and k. See \code{\link[=updateModel]{updateModel()}} for information on the params list} } \value{ a data frame of results diff --git a/man/simulation_chunks.Rd b/man/simulation_chunks.Rd new file mode 100644 index 00000000..f39b436e --- /dev/null +++ b/man/simulation_chunks.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/nhl-league-simulation.R +\name{simulation_chunks} +\alias{simulation_chunks} +\title{Split a simulation count into worker chunks} +\usage{ +simulation_chunks(nsims, n) +} +\arguments{ +\item{nsims}{(\code{integer(1)}) Total number of simulations to distribute.} + +\item{n}{(\code{integer(1)}) Number of chunks (worker tasks).} +} +\value{ +(\code{integer}) Vector of length \code{n} of chunk sizes whose sum equals +\code{nsims}. +} +\description{ +Distributes exactly \code{nsims} simulations across \code{n} chunks so the +remainder is spread over the first \code{nsims \%\% n} chunks (no simulations are +dropped or duplicated). +} +\keyword{internal} diff --git a/man/single_series_solver.Rd b/man/single_series_solver.Rd index f41d80f4..40098bf0 100644 --- a/man/single_series_solver.Rd +++ b/man/single_series_solver.Rd @@ -24,7 +24,7 @@ single_series_solver( \item{homeAwayOdds}{if calculated, the odds of a home or away team win} -\item{params}{The named list containing m, rho, beta, eta, and k. See \link{updateDC} for information on the params list} +\item{params}{The named list containing m, rho, beta, eta, and k. See \code{\link[=updateModel]{updateModel()}} for information on the params list} } \value{ a series winner (team name) diff --git a/man/todayDC.Rd b/man/todayDC.Rd index 1d5effa2..dc6247fe 100644 --- a/man/todayDC.Rd +++ b/man/todayDC.Rd @@ -15,7 +15,7 @@ todayDC( ) } \arguments{ -\item{params}{The named list containing m, rho, beta, eta, and k. See \link{updateDC} for information on the params list} +\item{params}{The named list containing m, rho, beta, eta, and k. See \code{\link[=updateModel]{updateModel()}} for information on the params list} \item{today}{Generate predictions for this date. Defaults to today} diff --git a/man/todayOdds.Rd b/man/todayOdds.Rd index e67c4e18..37c9b53c 100644 --- a/man/todayOdds.Rd +++ b/man/todayOdds.Rd @@ -14,7 +14,7 @@ todayOdds( ) } \arguments{ -\item{params}{The named list containing m, rho, beta, eta, and k. See \link{updateDC} for information on the params list} +\item{params}{The named list containing m, rho, beta, eta, and k. See \code{\link[=updateModel]{updateModel()}} for information on the params list} \item{today}{The date for which you want game odds} diff --git a/man/todayOddsPlot.Rd b/man/todayOddsPlot.Rd index f4454453..726d1035 100644 --- a/man/todayOddsPlot.Rd +++ b/man/todayOddsPlot.Rd @@ -15,7 +15,7 @@ todayOddsPlot( \arguments{ \item{date}{date to predict odds. Default today} -\item{params}{The named list containing m, rho, beta, eta, and k. See \link{updateDC} for information on the params list} +\item{params}{The named list containing m, rho, beta, eta, and k. See \code{\link[=updateModel]{updateModel()}} for information on the params list} \item{schedule}{HockeyModel::schedule or a custom value} diff --git a/man/tweetGames.Rd b/man/tweetGames.Rd index 104e093e..6ccfa420 100644 --- a/man/tweetGames.Rd +++ b/man/tweetGames.Rd @@ -18,7 +18,7 @@ tweetGames( \item{graphic_dir}{the graphics directory} -\item{params}{The named list containing m, rho, beta, eta, and k. See \link{updateDC} for information on the params list} +\item{params}{The named list containing m, rho, beta, eta, and k. See \code{\link[=updateModel]{updateModel()}} for information on the params list} } \value{ (\code{data.frame}) A summary of each attempted post (see diff --git a/man/tweetPlayoffOdds.Rd b/man/tweetPlayoffOdds.Rd index 48e678c2..ef05ebf3 100644 --- a/man/tweetPlayoffOdds.Rd +++ b/man/tweetPlayoffOdds.Rd @@ -14,7 +14,7 @@ tweetPlayoffOdds( \arguments{ \item{summary_results}{the summary results file, otherwise the most recent will be loaded} -\item{params}{The named list containing m, rho, beta, eta, and k. See \link{updateDC} for information on the params list} +\item{params}{The named list containing m, rho, beta, eta, and k. See \code{\link[=updateModel]{updateModel()}} for information on the params list} \item{graphic_dir}{graphic dir} diff --git a/man/tweetSeries.Rd b/man/tweetSeries.Rd index 1ac54f57..3f433465 100644 --- a/man/tweetSeries.Rd +++ b/man/tweetSeries.Rd @@ -11,7 +11,7 @@ tweetSeries( ) } \arguments{ -\item{params}{The named list containing m, rho, beta, eta, and k. See \link{updateDC} for information on the params list} +\item{params}{The named list containing m, rho, beta, eta, and k. See \code{\link[=updateModel]{updateModel()}} for information on the params list} \item{graphic_dir}{directory to save the image} diff --git a/man/updateDC.Rd b/man/updateDC.Rd deleted file mode 100644 index 045c06c4..00000000 --- a/man/updateDC.Rd +++ /dev/null @@ -1,49 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/nhl-dixon-coles-workflow.R -\name{updateDC} -\alias{updateDC} -\title{Update Dixon Coles parameters} -\usage{ -updateDC( - scores = HockeyModel::scores, - currentDate = Sys.Date(), - xi = DC_XI_NHL, - upsilon = DC_UPSILON_NHL, - nu = DC_NU_NHL, - save_data = TRUE -) -} -\arguments{ -\item{scores}{scores, if not then HockeyModel::scores is used} - -\item{currentDate}{Current Date, usually today but useful to set a different date if back calculating results} - -\item{xi}{(\code{double(1)}) Logistic slope for within-season time-decay -weighting. Defaults to \link{DC_XI_NHL}.} - -\item{upsilon}{(\code{double(1)}) Logistic midpoint (days) for within-season -time-decay weighting. Defaults to \link{DC_UPSILON_NHL}.} - -\item{nu}{(\code{double(1)}) Cross-season discounting exponent. \code{0} (default -\link{DC_NU_NHL}) disables cross-season discounting. See \code{\link[=DCweights]{DCweights()}} for -details.} - -\item{save_data}{Whether to save parameters to the package.} -} -\value{ -a named list containing m, rho, beta, eta and k values for the model. -} -\description{ -This function updates the model parameters to best fit the provided data. The parameters for this model are as follows: -\itemize{ -\item \link{m} is the result of the main model fit and contains team attack and defense strengths, plus home ice advantage terms -\item \link{rho} is the Dixon-Coles low scores adjustment term. -\item \link{beta} is the Weibull distribution's 'shape' parameter. This is used with \link{eta} to produce a curve multiplied by the diagonal score possibility matrix to enhance the odds of tie games -\item \link{eta} is the Weibull distribution's 'scale' parameter. See above for its importance -\item \link{k} is the multiplication factor used with the Weibull distribution to enhance ties -} -} -\seealso{ -\link{m}, \link{rho}, \link{beta}, \link{eta}, \link{k}, \link{DC_XI_NHL}, \link{DC_UPSILON_NHL}, -\link{DC_NU_NHL} -} diff --git a/man/updatePredictions.Rd b/man/updatePredictions.Rd index 48d7a2df..d09e3748 100644 --- a/man/updatePredictions.Rd +++ b/man/updatePredictions.Rd @@ -19,7 +19,7 @@ updatePredictions( \item{schedule}{HockeyModel::schedule or a custom value} -\item{params}{The named list containing m, rho, beta, eta, and k. See \link{updateDC} for information on the params list} +\item{params}{The named list containing m, rho, beta, eta, and k. See \code{\link[=updateModel]{updateModel()}} for information on the params list} \item{league}{which league front-end to run: \code{NULL}, \code{NA}, or \code{"both"} runs both leagues; \code{"nhl"} and \code{"pwhl"} run one league only} diff --git a/tests/testthat/helper-pwhl.R b/tests/testthat/helper-pwhl.R index 5ed62f7c..f01ecea5 100644 --- a/tests/testthat/helper-pwhl.R +++ b/tests/testthat/helper-pwhl.R @@ -79,7 +79,7 @@ make_pwhl_schedule <- function(scores) { } # Build DC params without running Weibull optimisation (for speed in tests -# that don't specifically test updatePWHLDC) +# that don't specifically test .update_dc_pwhl) make_pwhl_params <- function(scores) { sc <- pwhl_add_result(scores) m <- getM(scores = sc, currentDate = max(sc$Date) + 1) diff --git a/tests/testthat/test-frontend-core.R b/tests/testthat/test-frontend-core.R index 2b49f9c1..70c0d9bb 100644 --- a/tests/testthat/test-frontend-core.R +++ b/tests/testthat/test-frontend-core.R @@ -12,7 +12,7 @@ test_that("updateModel dispatches both leagues by default (#39)", { .update_model_nhl = function(save_data = TRUE) { list(source = "nhl", save_data = save_data) }, - updatePWHLModel = function(save_data = TRUE) { + .update_model_pwhl = function(save_data = TRUE) { list(source = "pwhl", save_data = save_data) }, .package = "HockeyModel" @@ -32,7 +32,7 @@ test_that("updateModel returns a single-league payload when requested (#39)", { .update_model_nhl = function(save_data = TRUE) { list(source = "nhl", save_data = save_data) }, - updatePWHLModel = function(save_data = TRUE) { + .update_model_pwhl = function(save_data = TRUE) { list(source = "pwhl", save_data = save_data) }, .package = "HockeyModel" diff --git a/tests/testthat/test-frontend-daily-summary.R b/tests/testthat/test-frontend-daily-summary.R index 3c829eed..683c2a1b 100644 --- a/tests/testthat/test-frontend-daily-summary.R +++ b/tests/testthat/test-frontend-daily-summary.R @@ -13,7 +13,7 @@ test_that("dailySummary uses option-based graphic defaults for both leagues (#39 observed$nhl <- graphic_dir "nhl-summary" }, - dailyPWHLSummary = function(graphic_dir, ...) { + .daily_summary_pwhl = function(graphic_dir, ...) { observed$pwhl <- graphic_dir "pwhl-summary" }, diff --git a/tests/testthat/test-frontend-plots.R b/tests/testthat/test-frontend-plots.R index 96aff8f8..9109e6bc 100644 --- a/tests/testthat/test-frontend-plots.R +++ b/tests/testthat/test-frontend-plots.R @@ -3,7 +3,7 @@ test_that("todayOddsPlot and dailySummary fan out by league (#39)", { .today_odds_plot_nhl = function(...) "nhl-today", .today_odds_plot_pwhl = function(...) "pwhl-today", .daily_summary_nhl = function(...) "nhl-summary", - dailyPWHLSummary = function(...) "pwhl-summary", + .daily_summary_pwhl = function(...) "pwhl-summary", .package = "HockeyModel" ) diff --git a/tests/testthat/test-nhl-dixon-coles-predict.R b/tests/testthat/test-nhl-dixon-coles-predict.R index c500ca65..802d0373 100644 --- a/tests/testthat/test-nhl-dixon-coles-predict.R +++ b/tests/testthat/test-nhl-dixon-coles-predict.R @@ -203,7 +203,7 @@ test_that("dcResult and dcExpandedOdds use otwinnerprob[2] consistently", { # ============ Regression tests for rho optimization fix ============ test_that("getRho produces valid rho in [-0.5, 0.5]", { # Rho must be within goalmodel bounds - params <- suppressWarnings(updateDC(save_data = FALSE)) + params <- suppressWarnings(.update_dc_nhl(save_data = FALSE)) expect_gte(params$rho, -0.5) expect_lte(params$rho, 0.5) }) @@ -374,11 +374,25 @@ test_that("dcPredictVectorized matches DCPredict per-game (draws = TRUE)", { "Philadelphia Flyers", "New Jersey Devils" ) - vec <- dcPredictVectorized(home = home, away = away, params = params, draws = TRUE) - ref <- t(vapply(seq_along(home), function(i) { - p <- DCPredict(home = home[i], away = away[i], params = params, draws = TRUE) - c(p[1], p[2], p[3]) - }, numeric(3))) + vec <- dcPredictVectorized( + home = home, + away = away, + params = params, + draws = TRUE + ) + ref <- t(vapply( + seq_along(home), + function(i) { + p <- DCPredict( + home = home[i], + away = away[i], + params = params, + draws = TRUE + ) + c(p[1], p[2], p[3]) + }, + numeric(3) + )) expect_equal(unname(vec), unname(ref), tolerance = 1e-10) expect_true(all(rowSums(vec) == 1)) }) @@ -390,11 +404,25 @@ test_that("dcPredictVectorized matches DCPredict per-game (draws = FALSE)", { params <- .parse_dc_params(NULL) home <- c("Toronto Maple Leafs", "New Jersey Devils", "Colorado Avalanche") away <- c("Ottawa Senators", "Philadelphia Flyers", "Dallas Stars") - vec <- dcPredictVectorized(home = home, away = away, params = params, draws = FALSE) - ref <- t(vapply(seq_along(home), function(i) { - p <- DCPredict(home = home[i], away = away[i], params = params, draws = FALSE) - c(p[1], p[2]) - }, numeric(2))) + vec <- dcPredictVectorized( + home = home, + away = away, + params = params, + draws = FALSE + ) + ref <- t(vapply( + seq_along(home), + function(i) { + p <- DCPredict( + home = home[i], + away = away[i], + params = params, + draws = FALSE + ) + c(p[1], p[2]) + }, + numeric(2) + )) expect_equal(unname(vec), unname(ref), tolerance = 1e-10) expect_true(all(rowSums(vec) == 1)) }) @@ -414,17 +442,21 @@ test_that("dcPredictVectorized matches DCPredict with regression (expected_mean, expected_mean = 2.835184, season_percent = 0.5 ) - ref <- t(vapply(seq_along(home), function(i) { - p <- DCPredict( - home = home[i], - away = away[i], - params = params, - draws = TRUE, - expected_mean = 2.835184, - season_percent = 0.5 - ) - c(p[1], p[2], p[3]) - }, numeric(3))) + ref <- t(vapply( + seq_along(home), + function(i) { + p <- DCPredict( + home = home[i], + away = away[i], + params = params, + draws = TRUE, + expected_mean = 2.835184, + season_percent = 0.5 + ) + c(p[1], p[2], p[3]) + }, + numeric(3) + )) expect_equal(unname(vec), unname(ref), tolerance = 1e-10) }) @@ -440,7 +472,7 @@ test_that("dcProbArray matches prob_matrix per-game", { params = params, maxgoal = 10 ) - expect_equal(arr[, , j], ref, tolerance = 1e-12) - expect_equal(sum(arr[, , j]), 1, tolerance = 1e-10) + expect_equal(arr[,, j], ref, tolerance = 1e-12) + expect_equal(sum(arr[,, j]), 1, tolerance = 1e-10) } }) diff --git a/tests/testthat/test-nhl-dixon-coles-workflow.R b/tests/testthat/test-nhl-dixon-coles-workflow.R index 312ffbda..f4c019fd 100644 --- a/tests/testthat/test-nhl-dixon-coles-workflow.R +++ b/tests/testthat/test-nhl-dixon-coles-workflow.R @@ -1,7 +1,7 @@ context("test-nhl-dixon-coles-workflow") test_that("Model params generate OK", { - params <- suppressWarnings(updateDC(save_data = FALSE)) + params <- suppressWarnings(.update_dc_nhl(save_data = FALSE)) expect_true(is.list(params)) expect_true(all(c("m", "rho", "beta", "eta", "k") %in% names(params))) @@ -17,8 +17,8 @@ test_that("Model params generate OK", { expect_true(all(is.finite(params$k)) && params$k > 0) }) -test_that("updateDC with historical date works", { - params <- suppressWarnings(updateDC( +test_that(".update_dc_nhl with historical date works", { + params <- suppressWarnings(.update_dc_nhl( currentDate = as.Date("2019-01-01"), save_data = FALSE )) diff --git a/tests/testthat/test-nhl-league-simulation.R b/tests/testthat/test-nhl-league-simulation.R index 6a4f2a52..1ea50a42 100644 --- a/tests/testthat/test-nhl-league-simulation.R +++ b/tests/testthat/test-nhl-league-simulation.R @@ -194,7 +194,9 @@ test_that("loopless_sim runs exactly the requested number of simulations (#51)", c("Date", "HomeTeam", "AwayTeam", "GameID", "GameType", "GameStatus") ] sched$GameStatus <- "FUT" - scor <- HockeyModel::scores[HockeyModel::scores$Date < as.Date("2025-10-07"), ] + scor <- HockeyModel::scores[ + HockeyModel::scores$Date < as.Date("2025-10-07"), + ] odds_table <- sched[, c("Date", "HomeTeam", "AwayTeam", "GameID")] odds_table$HomeWin <- 0.5 odds_table$AwayWin <- 0.3 diff --git a/tests/testthat/test-pwhl-daily-summary.R b/tests/testthat/test-pwhl-daily-summary.R index fcfba873..553179df 100644 --- a/tests/testthat/test-pwhl-daily-summary.R +++ b/tests/testthat/test-pwhl-daily-summary.R @@ -1,9 +1,9 @@ -test_that("dailyPWHLSummary() reports (not silently swallows) failed posts (#noissue)", { +test_that(".daily_summary_pwhl() reports (not silently swallows) failed posts (#noissue)", { withr::local_options(list( HockeyModel.prediction.path = withr::local_tempdir() )) local_mocked_bindings( - updatePWHLModel = function(...) { + .update_model_pwhl = function(...) { list( schedule = data.frame( Date = Sys.Date() + 1, @@ -26,17 +26,17 @@ test_that("dailyPWHLSummary() reports (not silently swallows) failed posts (#noi .package = "atrrr" ) - result <- suppressWarnings(dailyPWHLSummary(delay = 0)) + result <- suppressWarnings(.daily_summary_pwhl(delay = 0)) expect_true(is.data.frame(result)) expect_named(result, c("description", "success", "error")) }) -test_that("dailyPWHLSummary() attributes failed posts to their description (#noissue)", { +test_that(".daily_summary_pwhl() attributes failed posts to their description (#noissue)", { withr::local_options(list( HockeyModel.prediction.path = withr::local_tempdir() )) local_mocked_bindings( - updatePWHLModel = function(...) { + .update_model_pwhl = function(...) { list( schedule = data.frame( Date = Sys.Date() + 1, @@ -71,7 +71,7 @@ test_that("dailyPWHLSummary() attributes failed posts to their description (#noi result <- suppressWarnings( suppressMessages( - dailyPWHLSummary(graphic_dir = withr::local_tempdir(), delay = 0) + .daily_summary_pwhl(graphic_dir = withr::local_tempdir(), delay = 0) ) ) expect_equal(nrow(result), 2) diff --git a/tests/testthat/test-pwhl-model-core.R b/tests/testthat/test-pwhl-model-core.R index ac8f5405..a9d1d264 100644 --- a/tests/testthat/test-pwhl-model-core.R +++ b/tests/testthat/test-pwhl-model-core.R @@ -44,22 +44,22 @@ test_that("parse_pwhl_dc_params unwraps nested params", { expect_equal(params$m, "nested") }) -# ── updatePWHLDC ───────────────────────────────────────────────────────────── +# ── .update_dc_pwhl ────────────────────────────────────────────────────────── -test_that("updatePWHLDC rejects non-Date currentDate", { +test_that(".update_dc_pwhl rejects non-Date currentDate", { scores <- make_pwhl_scores() expect_error( - updatePWHLDC(scores, currentDate = "not-a-date"), + .update_dc_pwhl(scores, currentDate = "not-a-date"), class = "rlang_error" ) }) -test_that("updatePWHLDC errors on empty scores", { +test_that(".update_dc_pwhl errors on empty scores", { empty <- make_pwhl_scores(0) - expect_error(updatePWHLDC(empty), class = "rlang_error") + expect_error(.update_dc_pwhl(empty), class = "rlang_error") }) -test_that("updatePWHLDC returns a named list with the correct components", { +test_that(".update_dc_pwhl returns a named list with the correct components", { # Test the contract (m is a glm, rho/beta/eta/k are numeric) using # make_pwhl_params (bypasses the Weibull optimisation which needs real data) scores <- make_pwhl_scores(30) @@ -175,9 +175,9 @@ test_that("pwhl_loopless_sim top-4 playoff odds sum to roughly 4", { expect_true(abs(total_playoff_odds - 4) < 0.5) }) -# ── updatePWHLModel ─────────────────────────────────────────────────────────── +# ── .update_model_pwhl ──────────────────────────────────────────────────────── -test_that("updatePWHLModel returns list with scores, schedule, params", { +test_that(".update_model_pwhl returns list with scores, schedule, params", { scores_fixture <- make_pwhl_scores(30) schedule_fixture <- data.frame( Date = as.Date("2025-01-01"), @@ -193,10 +193,10 @@ test_that("updatePWHLModel returns list with scores, schedule, params", { local_mocked_bindings( updatePWHLScheduleAPI = function(...) schedule_fixture, updatePWHLScoresAPI = function(...) scores_fixture, - updatePWHLDC = function(...) params_fixture, + .update_dc_pwhl = function(...) params_fixture, .package = "HockeyModel" ) - result <- updatePWHLModel(save_data = FALSE) + result <- .update_model_pwhl(save_data = FALSE) expect_type(result, "list") expect_true(all(c("scores", "schedule", "params") %in% names(result))) expect_equal(nrow(result$schedule), 1) From 9b05cdbf1a1ef31cb4590122deaab7958e78a043 Mon Sep 17 00:00:00 2001 From: Philip Bulsink Date: Tue, 6 Oct 2026 21:38:29 -0400 Subject: [PATCH 2/2] refactor: rename all internal functions to use leading dot prefix (#42) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Apply the R convention that package-internal helpers carry a leading dot: 71 previously unexported functions (DCweights, prob_matrix, dcPredictVectorized, build_past_predictions, parseCores, buildTeamColours, getConferences, single_series_solver, etc.) are now .DCweights, .prob_matrix, .dcPredictVectorized, etc. across R/, tests/testthat/, and vignettes/. devtools::document() regenerates man/*.Rd (old .Rd pages deleted, dot-*.Rd pages created) and NAMESPACE (no change — these were never exported). NAMESPACE and DESCRIPTION are unchanged; only internal names shift. devtools::test: 803 pass, 0 fail. devtools::check: 0 errors, 0 warnings, 1 pre-existing NOTE (i binding, from PR #57, unrelated to this change). --- NEWS.md | 1 + R/constants.R | 8 +- R/data.R | 2 +- R/frontend-core.R | 4 +- R/frontend-daily-summary.R | 4 +- R/frontend-plots.R | 2 +- R/frontend-social.R | 20 ++-- R/graphics-odds.R | 6 +- R/graphics-pace.R | 10 +- R/graphics-plots.R | 8 +- R/graphics-predictions.R | 12 +-- R/graphics-tables.R | 10 +- R/metrics.R | 14 +-- R/nhl-api-fetch.R | 28 ++--- R/nhl-dixon-coles-fit.R | 28 ++--- R/nhl-dixon-coles-predict.R | 100 +++++++++--------- R/nhl-dixon-coles-workflow.R | 28 ++--- R/nhl-league-playoffs.R | 97 +++++++++-------- R/nhl-league-predictions-log.R | 4 +- R/nhl-league-simulation.R | 92 ++++++++-------- R/nhl-league-standings.R | 4 +- R/nhl-team-season-lookup.R | 54 +++++----- R/package-setup.R | 4 +- R/pwhl-api-fetch.R | 52 ++++----- R/pwhl-daily-summary.R | 2 +- R/pwhl-model-core.R | 20 ++-- R/tune_weights.R | 16 +-- R/utils-export.R | 2 +- R/validation-helpers.R | 18 ++-- man/DC_NU_NHL.Rd | 2 +- man/DC_NU_PWHL.Rd | 2 +- ...ecover.Rd => dot-DCPredictErrorRecover.Rd} | 6 +- man/{DCRhoLogLik.Rd => dot-DCRhoLogLik.Rd} | 6 +- man/{DCweights.Rd => dot-DCweights.Rd} | 8 +- ...d => dot-add_postponed_to_schedule_end.Rd} | 6 +- ...Colours.Rd => dot-buildPWHLTeamColours.Rd} | 6 +- ...TeamColours.Rd => dot-buildTeamColours.Rd} | 6 +- ...tions.Rd => dot-build_past_predictions.Rd} | 6 +- man/{cleanModel.Rd => dot-cleanModel.Rd} | 6 +- man/{clean_names.Rd => dot-clean_names.Rd} | 6 +- man/dot-daily_summary_nhl.Rd | 2 +- ...cExpandedOdds.Rd => dot-dcExpandedOdds.Rd} | 6 +- man/{dcLambda.Rd => dot-dcLambda.Rd} | 6 +- ...ctorized.Rd => dot-dcPredictVectorized.Rd} | 8 +- man/{dcProbArray.Rd => dot-dcProbArray.Rd} | 8 +- man/{dcProbMatrix.Rd => dot-dcProbMatrix.Rd} | 6 +- man/{dcResult.Rd => dot-dcResult.Rd} | 6 +- man/{dcxG.Rd => dot-dcxG.Rd} | 6 +- ..._starts.Rd => dot-derive_season_starts.Rd} | 6 +- ...raTimeSolver.Rd => dot-extraTimeSolver.Rd} | 6 +- ... => dot-formatPredsForHockeyVisContest.Rd} | 6 +- ...eAwayOdds.Rd => dot-getAllHomeAwayOdds.Rd} | 6 +- ...tedSeries.Rd => dot-getCompletedSeries.Rd} | 6 +- ...etConferences.Rd => dot-getConferences.Rd} | 6 +- man/{getDivisions.Rd => dot-getDivisions.Rd} | 6 +- man/{getLongTeam.Rd => dot-getLongTeam.Rd} | 6 +- man/{getNumGames.Rd => dot-getNumGames.Rd} | 6 +- man/{getShortTeam.Rd => dot-getShortTeam.Rd} | 6 +- ...nferences.Rd => dot-getTeamConferences.Rd} | 6 +- ...amDivisions.Rd => dot-getTeamDivisions.Rd} | 6 +- ...n_dates.Rd => dot-get_prediction_dates.Rd} | 6 +- ...ricalPoints.Rd => dot-historicalPoints.Rd} | 6 +- ...d_or_get_nst.Rd => dot-load_or_get_nst.Rd} | 6 +- man/{nhl_boxscore.Rd => dot-nhl_boxscore.Rd} | 6 +- man/{parseCores.Rd => dot-parseCores.Rd} | 6 +- ..._params.Rd => dot-parse_pwhl_dc_params.Rd} | 6 +- man/{prob_matrix.Rd => dot-prob_matrix.Rd} | 10 +- ...l_add_result.Rd => dot-pwhl_add_result.Rd} | 6 +- ...api_request.Rd => dot-pwhl_api_request.Rd} | 6 +- ...me_summary.Rd => dot-pwhl_game_summary.Rd} | 6 +- ..._name.Rd => dot-pwhl_resolve_team_name.Rd} | 6 +- ..._date.Rd => dot-pwhl_season_start_date.Rd} | 6 +- ...eseedTwoTeams.Rd => dot-reseedTwoTeams.Rd} | 6 +- man/{sampleResult.Rd => dot-sampleResult.Rd} | 6 +- ...sonValidator.Rd => dot-seasonValidator.Rd} | 6 +- man/{sim_batch.Rd => dot-sim_batch.Rd} | 6 +- ...dds_results.Rd => dot-sim_odds_results.Rd} | 6 +- ...ion_chunks.Rd => dot-simulation_chunks.Rd} | 6 +- ..._solver.Rd => dot-single_series_solver.Rd} | 6 +- man/{tau_singular.Rd => dot-tau_singular.Rd} | 6 +- man/{todayDC.Rd => dot-todayDC.Rd} | 6 +- ...une_dc_weight.Rd => dot-tune_dc_weight.Rd} | 10 +- man/{tweet.Rd => dot-tweet.Rd} | 6 +- man/dot-update_dc_nhl.Rd | 2 +- man/dot-update_dc_pwhl.Rd | 2 +- ...robMatrix.Rd => dot-validateProbMatrix.Rd} | 6 +- man/tweetGames.Rd | 2 +- tests/testthat/helper-pwhl.R | 4 +- tests/testthat/test-frontend-plots.R | 24 ++--- tests/testthat/test-frontend-social.R | 8 +- tests/testthat/test-graphics-odds.R | 6 +- tests/testthat/test-graphics-pace.R | 4 +- tests/testthat/test-graphics-plots.R | 2 +- tests/testthat/test-graphics-predictions.R | 8 +- tests/testthat/test-graphics-tables.R | 4 +- tests/testthat/test-nhl-api-fetch.R | 18 ++-- tests/testthat/test-nhl-dixon-coles-fit.R | 36 +++---- tests/testthat/test-nhl-dixon-coles-predict.R | 82 +++++++------- .../testthat/test-nhl-dixon-coles-workflow.R | 30 +++--- tests/testthat/test-nhl-league-playoffs.R | 2 +- .../test-nhl-league-predictions-log.R | 2 +- tests/testthat/test-nhl-league-simulation.R | 22 ++-- tests/testthat/test-nhl-team-season-lookup.R | 6 +- tests/testthat/test-pwhl-api-fetch.R | 8 +- tests/testthat/test-pwhl-daily-summary.R | 4 +- tests/testthat/test-pwhl-model-core.R | 24 ++--- tests/testthat/test-utils-export.R | 2 +- tests/testthat/test-validation-helpers.R | 10 +- vignettes/model-description.Rmd | 4 +- 109 files changed, 646 insertions(+), 652 deletions(-) rename man/{DCPredictErrorRecover.Rd => dot-DCPredictErrorRecover.Rd} (81%) rename man/{DCRhoLogLik.Rd => dot-DCRhoLogLik.Rd} (86%) rename man/{DCweights.Rd => dot-DCweights.Rd} (94%) rename man/{add_postponed_to_schedule_end.Rd => dot-add_postponed_to_schedule_end.Rd} (82%) rename man/{buildPWHLTeamColours.Rd => dot-buildPWHLTeamColours.Rd} (81%) rename man/{buildTeamColours.Rd => dot-buildTeamColours.Rd} (82%) rename man/{build_past_predictions.Rd => dot-build_past_predictions.Rd} (91%) rename man/{cleanModel.Rd => dot-cleanModel.Rd} (83%) rename man/{clean_names.Rd => dot-clean_names.Rd} (88%) rename man/{dcExpandedOdds.Rd => dot-dcExpandedOdds.Rd} (85%) rename man/{dcLambda.Rd => dot-dcLambda.Rd} (87%) rename man/{dcPredictVectorized.Rd => dot-dcPredictVectorized.Rd} (89%) rename man/{dcProbArray.Rd => dot-dcProbArray.Rd} (84%) rename man/{dcProbMatrix.Rd => dot-dcProbMatrix.Rd} (94%) rename man/{dcResult.Rd => dot-dcResult.Rd} (85%) rename man/{dcxG.Rd => dot-dcxG.Rd} (88%) rename man/{derive_season_starts.Rd => dot-derive_season_starts.Rd} (89%) rename man/{extraTimeSolver.Rd => dot-extraTimeSolver.Rd} (86%) rename man/{formatPredsForHockeyVisContest.Rd => dot-formatPredsForHockeyVisContest.Rd} (86%) rename man/{getAllHomeAwayOdds.Rd => dot-getAllHomeAwayOdds.Rd} (82%) rename man/{getCompletedSeries.Rd => dot-getCompletedSeries.Rd} (83%) rename man/{getConferences.Rd => dot-getConferences.Rd} (80%) rename man/{getDivisions.Rd => dot-getDivisions.Rd} (80%) rename man/{getLongTeam.Rd => dot-getLongTeam.Rd} (81%) rename man/{getNumGames.Rd => dot-getNumGames.Rd} (82%) rename man/{getShortTeam.Rd => dot-getShortTeam.Rd} (80%) rename man/{getTeamConferences.Rd => dot-getTeamConferences.Rd} (77%) rename man/{getTeamDivisions.Rd => dot-getTeamDivisions.Rd} (78%) rename man/{get_prediction_dates.Rd => dot-get_prediction_dates.Rd} (80%) rename man/{historicalPoints.Rd => dot-historicalPoints.Rd} (82%) rename man/{load_or_get_nst.Rd => dot-load_or_get_nst.Rd} (92%) rename man/{nhl_boxscore.Rd => dot-nhl_boxscore.Rd} (85%) rename man/{parseCores.Rd => dot-parseCores.Rd} (86%) rename man/{parse_pwhl_dc_params.Rd => dot-parse_pwhl_dc_params.Rd} (86%) rename man/{prob_matrix.Rd => dot-prob_matrix.Rd} (71%) rename man/{pwhl_add_result.Rd => dot-pwhl_add_result.Rd} (90%) rename man/{pwhl_api_request.Rd => dot-pwhl_api_request.Rd} (82%) rename man/{pwhl_game_summary.Rd => dot-pwhl_game_summary.Rd} (81%) rename man/{pwhl_resolve_team_name.Rd => dot-pwhl_resolve_team_name.Rd} (73%) rename man/{pwhl_season_start_date.Rd => dot-pwhl_season_start_date.Rd} (74%) rename man/{reseedTwoTeams.Rd => dot-reseedTwoTeams.Rd} (84%) rename man/{sampleResult.Rd => dot-sampleResult.Rd} (89%) rename man/{seasonValidator.Rd => dot-seasonValidator.Rd} (83%) rename man/{sim_batch.Rd => dot-sim_batch.Rd} (92%) rename man/{sim_odds_results.Rd => dot-sim_odds_results.Rd} (91%) rename man/{simulation_chunks.Rd => dot-simulation_chunks.Rd} (88%) rename man/{single_series_solver.Rd => dot-single_series_solver.Rd} (93%) rename man/{tau_singular.Rd => dot-tau_singular.Rd} (87%) rename man/{todayDC.Rd => dot-todayDC.Rd} (96%) rename man/{tune_dc_weight.Rd => dot-tune_dc_weight.Rd} (87%) rename man/{tweet.Rd => dot-tweet.Rd} (94%) rename man/{validateProbMatrix.Rd => dot-validateProbMatrix.Rd} (90%) diff --git a/NEWS.md b/NEWS.md index aa755832..2397779b 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,6 @@ # HockeyModel 2026.0.1.9000 (development version) +* All internal (non-exported) functions now use a leading dot prefix (e.g. `.DCweights()` instead of `DCweights()`), following the R convention for package-internal helpers; 71 functions were renamed across `R/`, `tests/`, and `vignettes/` (@pbulsink, #42). * `updateModel()` and `dailySummary()` are now the single entry points for updating and summarising both leagues; the former league-specific exports `updateDC()`, `updatePWHLDC()`, `updatePWHLModel()`, and `dailyPWHLSummary()` are now internal (`.update_dc_nhl()`, `.update_dc_pwhl()`, `.update_model_pwhl()`, `.daily_summary_pwhl()`), and the `params` argument in the NHL prediction/simulation/social-media functions now documents the correct source of the params list (#42). * `simulateSeasonParallel()` no longer copies the invariant odds columns into the per-simulation score table on every iteration (the sampled outcome columns are built separately via a new internal `sim_odds_results()`), removing the redundant per-iteration data copying; its parallel branch now runs simulations in `cores` batched tasks (each worker handling several simulations) instead of one task per simulation, so the invariant table is serialised to each worker only `cores` times rather than `nsims` times (@pbulsink, #45). * `loopless_sim()`'s parallel branch now distributes exactly `nsims` simulations across `cores` chunks (remainder spread over the first `nsims %% cores` workers) via a new internal `simulation_chunks()` helper, instead of the previous `floor(nsims / cores)` per task that silently dropped the remainder and produced a total that rarely matched the requested `nsims` (@pbulsink, #51). diff --git a/R/constants.R b/R/constants.R index 7e723619..336160f5 100644 --- a/R/constants.R +++ b/R/constants.R @@ -1,6 +1,6 @@ # Package-level weighting constants for the Dixon-Coles model. # -# These values control how `DCweights()` (and therefore `getM()`) decays the +# These values control how `.DCweights()` (and therefore `getM()`) decays the # influence of historical games. Two separate components are used: # # 1. **Sigmoid within-season decay** (parameters xi and upsilon) @@ -16,7 +16,7 @@ # # NHL values were originally tuned on full NHL history; PWHL values use # nu = 2 as a starting point to reflect the high year-to-year roster churn -# from expansion drafts. Run `tune_dc_weight(league = "PWHL")` to find the +# from expansion drafts. Run `.tune_dc_weight(league = "PWHL")` to find the # optimal values. #' Default NHL Dixon-Coles sigmoid time-decay slope @@ -35,7 +35,7 @@ DC_UPSILON_NHL <- 365 #' #' `nu = 0` disables cross-season discounting for NHL (seasons are relatively #' stable year-to-year). Increase to down-weight older seasons more -#' aggressively. Tune with [tune_dc_weight()]. +#' aggressively. Tune with [.tune_dc_weight()]. #' @keywords internal DC_NU_NHL <- 0 @@ -53,6 +53,6 @@ DC_UPSILON_PWHL <- 461.0156 #' #' `nu = 2` provides moderate cross-season discounting for PWHL, reflecting #' the high year-to-year roster volatility from expansion drafts. Tune with -#' `tune_dc_weight(league = "PWHL")`. +#' `.tune_dc_weight(league = "PWHL")`. #' @keywords internal DC_NU_PWHL <- 5 diff --git a/R/data.R b/R/data.R index 0109353a..93aa7313 100644 --- a/R/data.R +++ b/R/data.R @@ -224,7 +224,7 @@ #' @returns `NULL` (invisibly). Writes updated data when `usethis` is #' available. #' @keywords internal -buildTeamColours <- function() { +.buildTeamColours <- function() { teamColours <- utils::read.csv( "./data-raw/logos/team_colours.csv", stringsAsFactors = FALSE diff --git a/R/frontend-core.R b/R/frontend-core.R index f43da219..41a41e11 100644 --- a/R/frontend-core.R +++ b/R/frontend-core.R @@ -215,7 +215,7 @@ updateModel <- function(save_data = TRUE, league = NULL) { if (scores$Date[nrow(scores)] < (Sys.Date())) { updateScoresAPI(save_data = TRUE) } - pdates <- get_prediction_dates(data_dir) + pdates <- .get_prediction_dates(data_dir) lastp <- if (length(pdates) == 0L) { as.Date(getSeasonStartDate()) - 1L } else { @@ -251,7 +251,7 @@ updateModel <- function(save_data = TRUE, league = NULL) { schedule = HockeyModel::pwhlSchedule, params = NULL ) { - params <- parse_pwhl_dc_params(params) + params <- .parse_pwhl_dc_params(params) if (!dir.exists(data_dir)) { dir.create(data_dir, recursive = TRUE) diff --git a/R/frontend-daily-summary.R b/R/frontend-daily-summary.R index 9a46486f..43671568 100644 --- a/R/frontend-daily-summary.R +++ b/R/frontend-daily-summary.R @@ -4,7 +4,7 @@ #' #' @param graphic_dir Directory for graphic files #' @param subdir subdirectory to `graphic_dir` for pace plots -#' @param delay delay between tweet posts +#' @param delay delay between .tweet posts #' @returns (`data.frame`) A combined summary of every attempted social post #' across the run (see `.summarize_post_results()` in `frontend-social.R`), #' invisibly. @@ -198,7 +198,7 @@ } message("Posting Tweets...") - post_results[[length(post_results) + 1]] <- tweet( + post_results[[length(post_results) + 1]] <- .tweet( graphic_dir = graphic_dir, delay = delay ) diff --git a/R/frontend-plots.R b/R/frontend-plots.R index b2da489f..9291a925 100644 --- a/R/frontend-plots.R +++ b/R/frontend-plots.R @@ -49,7 +49,7 @@ schedule = HockeyModel::pwhlSchedule, scores = HockeyModel::pwhlScores ) { - params <- parse_pwhl_dc_params(params) + params <- .parse_pwhl_dc_params(params) if (nrow(scores) > 0 && scores$Date[nrow(scores)] < (date - 7)) { cli::cli_alert_info( diff --git a/R/frontend-social.R b/R/frontend-social.R index 224b9e81..d9d93d41 100644 --- a/R/frontend-social.R +++ b/R/frontend-social.R @@ -79,7 +79,7 @@ #' @returns (`data.frame`) A summary of each attempted post (see #' `.summarize_post_results()`), invisibly. #' @keywords internal -tweet <- function( +.tweet <- function( graphic_dir = .default_nhl_graphics_dir(), delay = stats::runif(1, min = 2, max = 6) * 60 ) { @@ -172,7 +172,7 @@ tweetPace <- function( scores = scores ) - pdates <- get_prediction_dates(prediction_dir) + pdates <- .get_prediction_dates(prediction_dir) if (length(pdates) == 0L) { cli::cli_abort("No prediction files found in {.path {prediction_dir}}.") } @@ -271,7 +271,7 @@ tweetPace <- function( scores = scores ) - for (division in getDivisions()) { + for (division in .getDivisions()) { status <- paste( "Current Points compared to predicted (at season start) for #NHL teams in the", division, @@ -318,7 +318,7 @@ tweetLikelihoods <- function( # make likelihood plots plot_point_likelihood(graphic_dir = graphic_dir, subdir = subdir) - for (conf in getConferences()) { + for (conf in .getConferences()) { if ( file.exists(file.path( graphic_dir, @@ -364,7 +364,7 @@ tweetLikelihoods <- function( #' Tweet Game Plots #' -#' @param games Games to tweet graphics from +#' @param games Games to .tweet graphics from #' @param delay Delay between tweets #' @param graphic_dir the graphics directory #' @param params The named list containing m, rho, beta, eta, and k. See [updateModel()] for information on the params list @@ -382,12 +382,12 @@ tweetGames <- function( post_results <- list() # Tweet each game if (is.null(games)) { - message("No games to tweet") + message("No games to .tweet") return(invisible(.summarize_post_results(post_results))) } if (nrow(games) == 0) { - message("No games to tweet") + message("No games to .tweet") return(invisible(.summarize_post_results(post_results))) } @@ -417,9 +417,9 @@ tweetGames <- function( " at ", teamColours[teamColours$Team == home, "Hashtag"], " predicted goals. #", - getShortTeam(away), + .getShortTeam(away), "vs", - getShortTeam(home), + .getShortTeam(home), " #HockeyTwitter" ) @@ -591,7 +591,7 @@ tweetPlayoffOdds <- function( return(invisible(.summarize_post_results(post_results))) } - playoffodds$Conference <- getTeamConferences(playoffodds$Team) + playoffodds$Conference <- .getTeamConferences(playoffodds$Team) if (trimcup) { plt <- format_playoff_odds( playoff_odds = playoffodds, diff --git a/R/graphics-odds.R b/R/graphics-odds.R index 4a2c5861..da9f67a6 100644 --- a/R/graphics-odds.R +++ b/R/graphics-odds.R @@ -25,7 +25,7 @@ plot_odds_today <- function( ) } params <- .parse_dc_params(params) - todayodds <- todayDC(today = today, params, schedule = schedule) + todayodds <- .todayDC(today = today, params, schedule = schedule) if (is.null(todayodds)) { return(NULL) } @@ -33,12 +33,12 @@ plot_odds_today <- function( # add odds for each team in OT/SO for (g in seq_len(nrow(todayodds))) { - todayodds$HomeWinOT[g] <- extraTimeSolver( + todayodds$HomeWinOT[g] <- .extraTimeSolver( home_win = todayodds$HomeWin[g], away_win = todayodds$AwayWin[g], draw = todayodds$Draw[g] )[2] - todayodds$AwayWinOT[g] <- extraTimeSolver( + todayodds$AwayWinOT[g] <- .extraTimeSolver( home_win = todayodds$HomeWin[g], away_win = todayodds$AwayWin[g], draw = todayodds$Draw[g] diff --git a/R/graphics-pace.R b/R/graphics-pace.R index e2a030a7..9e94a84f 100644 --- a/R/graphics-pace.R +++ b/R/graphics-pace.R @@ -33,7 +33,7 @@ plot_pace_by_division <- function( dir.create(file.path(graphic_dir, subdir), recursive = TRUE) } - ngames <- getNumGames() + ngames <- .getNumGames() teamlist <- unique(c(as.character(sc$HomeTeam), as.character(sc$AwayTeam))) @@ -102,7 +102,7 @@ plot_pace_by_division <- function( "PointDiff" ] lab <- paste0( - getShortTeam(team), + .getShortTeam(team), " - ", teampoints[team], " pts. (", @@ -121,7 +121,7 @@ plot_pace_by_division <- function( ] <- lab } - teamPerformance$Div <- getTeamDivisions(teamPerformance$Team) + teamPerformance$Div <- .getTeamDivisions(teamPerformance$Team) for (division in unique(teamPerformance$Div)) { # tl<-teamlist[teamlist %in% unlist(HockeyModel::nhl_divisions[division])] @@ -219,7 +219,7 @@ plot_pace_by_team <- function( paste0(getSeasonStartDate(), "-predictions.RDS") )) - pdates <- get_prediction_dates(prediction_dir) + pdates <- .get_prediction_dates(prediction_dir) if (length(pdates) == 0L) { cli::cli_abort("No prediction files found in {.path {prediction_dir}}.") } @@ -229,7 +229,7 @@ plot_pace_by_team <- function( if (!dir.exists(file.path(graphic_dir, subdir))) { dir.create(file.path(graphic_dir, subdir), recursive = TRUE) } - numgames <- getNumGames() + numgames <- .getNumGames() teamColours <- HockeyModel::teamColours diff --git a/R/graphics-plots.R b/R/graphics-plots.R index 32f32210..5d81e93d 100644 --- a/R/graphics-plots.R +++ b/R/graphics-plots.R @@ -38,21 +38,21 @@ plot_game <- function(home, away, params = NULL, maxgoal = 10) { # fix errors if (!is.numeric(lambda)) { - lambda <- DCPredictErrorRecover( + lambda <- .DCPredictErrorRecover( team = home, opponent = away, homeiceadv = TRUE ) } if (!is.numeric(mu)) { - mu <- DCPredictErrorRecover( + mu <- .DCPredictErrorRecover( team = away, opponent = home, homeiceadv = FALSE ) } - probability_matrix <- dcProbMatrix( + probability_matrix <- .dcProbMatrix( home = home, away = away, params = params, @@ -189,7 +189,7 @@ plot_point_likelihood <- function( preds <- loopless_sim(nsims = 1e4)$raw_results } - preds$Conf <- getTeamConferences(preds$Team) + preds$Conf <- .getTeamConferences(preds$Team) conferences <- unique(preds$Conf) diff --git a/R/graphics-predictions.R b/R/graphics-predictions.R index dbdd0e54..821d4e96 100644 --- a/R/graphics-predictions.R +++ b/R/graphics-predictions.R @@ -50,7 +50,7 @@ plot_prediction_points_by_team <- function( teams <- unique(all_predictions$Team) dates <- as.Date(unique(all_predictions$predictionDate)) # Get division - all_predictions$Division <- getTeamDivisions( + all_predictions$Division <- .getTeamDivisions( all_predictions$Team, teamColours = teamColours ) @@ -63,7 +63,7 @@ plot_prediction_points_by_team <- function( all_predictions$label <- ifelse( all_predictions$predictionDate == max(all_predictions$predictionDate), as.character(paste0( - getShortTeam(all_predictions$Team, teamColours = teamColours), + .getShortTeam(all_predictions$Team, teamColours = teamColours), "\n", round(all_predictions$meanPoints, digits = 0) )), @@ -149,7 +149,7 @@ plot_prediction_playoffs_by_team <- function( # extract constants teams <- unique(all_predictions$Team) # Get division - all_predictions$Division <- getTeamDivisions( + all_predictions$Division <- .getTeamDivisions( all_predictions$Team, teamColours = teamColours ) @@ -175,7 +175,7 @@ plot_prediction_playoffs_by_team <- function( label[playoff_odds == 0] <- "0" label <- paste0( - getShortTeam( + .getShortTeam( all_predictions[all_predictions$predictionDate == lastdate, ]$Team, teamColours = teamColours ), @@ -279,7 +279,7 @@ plot_prediction_presidents_by_team <- function( teams <- unique(all_predictions$Team) dates <- as.Date(unique(all_predictions$predictionDate)) # Get division - all_predictions$Division <- getTeamDivisions( + all_predictions$Division <- .getTeamDivisions( all_predictions$Team, teamColours = teamColours ) @@ -292,7 +292,7 @@ plot_prediction_presidents_by_team <- function( all_predictions$label <- ifelse( all_predictions$predictionDate == max(all_predictions$predictionDate), as.character(paste0( - getShortTeam(all_predictions$Team, teamColours = teamColours), + .getShortTeam(all_predictions$Team, teamColours = teamColours), "\n", signif(all_predictions$Presidents * 100, digits = 2), "%" diff --git a/R/graphics-tables.R b/R/graphics-tables.R index 96de5e51..f850767e 100644 --- a/R/graphics-tables.R +++ b/R/graphics-tables.R @@ -207,7 +207,7 @@ daily_odds_table <- function( ) } params <- .parse_dc_params(params) - todayodds <- todayDC( + todayodds <- .todayDC( today = as.Date(today), params = params, schedule = schedule @@ -219,7 +219,7 @@ daily_odds_table <- function( todayodds$AwayxG <- NA for (g in seq_len(nrow(todayodds))) { - xg <- dcxG( + xg <- .dcxG( home = todayodds$HomeTeam[g], away = todayodds$AwayTeam[g], params = params @@ -499,7 +499,7 @@ series_odds_table <- function( } # Resolve a team name to its local logo path (falls back to nhl or pwhl logo) - team_logo_path <- function(team_name, league) { + .team_logo_path <- function(team_name, league) { candidate <- file.path( getOption("HockeyModel.data.path"), "logos", @@ -607,7 +607,7 @@ series_odds_table <- function( locations = gt::cells_body(columns = "homeimage", rows = i), fn = function(x) { gt::local_image( - filename = team_logo_path(x, league), + filename = .team_logo_path(x, league), height = "30px" ) } @@ -616,7 +616,7 @@ series_odds_table <- function( locations = gt::cells_body(columns = "awayimage", rows = i), fn = function(x) { gt::local_image( - filename = team_logo_path(x, league), + filename = .team_logo_path(x, league), height = "30px" ) } diff --git a/R/metrics.R b/R/metrics.R index ef2a8ff5..dcc49651 100644 --- a/R/metrics.R +++ b/R/metrics.R @@ -1,6 +1,6 @@ # Prediction-evaluation metrics (log loss, accuracy, AUC, RMSE, R^2, MSE) -validate_metric_inputs <- function(predicted, actual, fn_name) { +.validate_metric_inputs <- function(predicted, actual, fn_name) { if (length(predicted) != length(actual)) { cli::cli_abort(c( "Error in HockeyModel::{fn_name}()", @@ -20,7 +20,7 @@ validate_metric_inputs <- function(predicted, actual, fn_name) { #' @return a log loss value for the event(s) #' @export logLoss <- function(predicted, actual) { - validate_metric_inputs(predicted, actual, "logLoss") + .validate_metric_inputs(predicted, actual, "logLoss") predicted[predicted == 0] <- 1e-15 predicted[predicted == 1] <- 1 - 1e-15 @@ -40,7 +40,7 @@ logLoss <- function(predicted, actual) { #' @return a percentage of correct predictions #' @export accuracy <- function(predicted, actual) { - validate_metric_inputs(predicted, actual, "accuracy") + .validate_metric_inputs(predicted, actual, "accuracy") predicted <- as.numeric(predicted > 0.5) actual <- as.numeric(actual > 0.5) @@ -60,7 +60,7 @@ accuracy <- function(predicted, actual) { #' @return a single value for auc #' @export auc <- function(predicted, actual) { - validate_metric_inputs(predicted, actual, "auc") + .validate_metric_inputs(predicted, actual, "auc") actual <- as.numeric(actual > 0.5) @@ -84,7 +84,7 @@ auc <- function(predicted, actual) { #' @return a single value for RMSE #' @export rmse <- function(predicted, actual) { - validate_metric_inputs(predicted, actual, "rmse") + .validate_metric_inputs(predicted, actual, "rmse") return(sqrt(mean((actual - predicted)^2))) } @@ -99,7 +99,7 @@ rmse <- function(predicted, actual) { #' @return a single value for R^2 #' @export rsquare <- function(predicted, actual) { - validate_metric_inputs(predicted, actual, "rsquare") + .validate_metric_inputs(predicted, actual, "rsquare") return(stats::cor(predicted, actual)^2) } @@ -113,7 +113,7 @@ rsquare <- function(predicted, actual) { #' @return a single value for MSE #' @export mse <- function(predicted, actual) { - validate_metric_inputs(predicted, actual, "mse") + .validate_metric_inputs(predicted, actual, "mse") return(mean((actual - predicted)^2)) } diff --git a/R/nhl-api-fetch.R b/R/nhl-api-fetch.R index 9cb1e61e..aa10d59a 100644 --- a/R/nhl-api-fetch.R +++ b/R/nhl-api-fetch.R @@ -57,7 +57,7 @@ getNHLSchedule <- function( season = getCurrentSeason8(), teamColours = HockeyModel::teamColours ) { - if (!seasonValidator(season)) { + if (!.seasonValidator(season)) { cli::cli_abort( "{.arg season} must be a valid NHL season ID (e.g. {.val 20202021})." ) @@ -115,8 +115,8 @@ getNHLSchedule <- function( data.frame( Date = sg$gameDate, - HomeTeam = getLongTeam(sg$homeTeam$abbrev), - AwayTeam = getLongTeam(sg$awayTeam$abbrev), + HomeTeam = .getLongTeam(sg$homeTeam$abbrev), + AwayTeam = .getLongTeam(sg$awayTeam$abbrev), GameID = sg$id, GameType = ifelse( sg$gameType == 2, @@ -311,7 +311,7 @@ getNHLScores <- function( for (g in gameIDs) { sc <- NA tryCatch( - sc <- nhl_boxscore(g), + sc <- .nhl_boxscore(g), error = function(e) message("Error in GameID", g, ": ", e) ) @@ -365,7 +365,7 @@ getNHLScores <- function( } if (!is.null(scores)) { - scores <- clean_names(scores) + scores <- .clean_names(scores) # Convert OTStatus to character with consistent handling of numeric and NA values scores <- scores |> @@ -441,7 +441,7 @@ getNHLScores <- function( #' parameter so tests can point it at a temporary file. #' @returns (`data.frame`) Natural Stat Trick report rows for `gid`. #' @keywords internal -load_or_get_nst <- function( +.load_or_get_nst <- function( gid, cache_path = getOption( "HockeyModel.nst.cache.path", @@ -518,14 +518,14 @@ load_or_get_nst <- function( #' if one game ID supplied, or a data frame with those columns #' @export get_xg <- function(gameIds) { - gxg <- function(gid) { + .gxg <- function(gid) { season <- as.numeric(substr(gid, 1, 4)) if (season < 2007) { return(list("GameID" = gid, "HomexG" = NA, "AwayxG" = NA)) } - nst_report <- load_or_get_nst(gid) + nst_report <- .load_or_get_nst(gid) # Issue 3.12: Validate NST report structure before accessing columns if (!is.data.frame(nst_report) || nrow(nst_report) == 0) { @@ -590,11 +590,11 @@ get_xg <- function(gameIds) { if (length(gameIds) == 0) { return(NA) } else if (length(gameIds) == 1) { - return(as.data.frame(gxg(gameIds))) + return(as.data.frame(.gxg(gameIds))) } else { gxgs <- data.frame() for (i in seq_along(gameIds)) { - gxgs <- dplyr::bind_rows(gxgs, gxg(gameIds[i])) + gxgs <- dplyr::bind_rows(gxgs, .gxg(gameIds[i])) } return(gxgs) @@ -654,7 +654,7 @@ updateScoresAPI <- function( #' @returns (`vector` or `data.frame`) `sc` with normalized historical and #' accented team names. #' @keywords internal -clean_names <- function(sc) { +.clean_names <- function(sc) { if (is.vector(sc)) { sc <- stringi::stri_trans_general(str = sc, "latin-ascii") sc <- replace(sc, sc == "Utah Utah Hockey Club", "Utah Hockey Club") @@ -873,7 +873,7 @@ clean_names <- function(sc) { #' whether the series is complete #' @export getAPISeries <- function(season = getCurrentSeason8(), wins_required = 4) { - if (!seasonValidator(season)) { + if (!.seasonValidator(season)) { cli::cli_abort( "{.arg season} must be an 8-digit season ID string like {.val 20182019}." ) @@ -912,7 +912,7 @@ getAPISeries <- function(season = getCurrentSeason8(), wins_required = 4) { return(data.frame()) } - playoffSeries <- clean_names(playoffSeries) + playoffSeries <- .clean_names(playoffSeries) playoffSeries$Status <- ifelse( playoffSeries$HomeWins >= wins_required | @@ -945,7 +945,7 @@ getAPISeries <- function(season = getCurrentSeason8(), wins_required = 4) { #' @param gid (`character(1)` or `numeric(1)`) NHL game ID. #' @returns (`list`) Parsed boxscore response from the NHL API. #' @keywords internal -nhl_boxscore <- function(gid) { +.nhl_boxscore <- function(gid) { url <- paste0("https://api-web.nhle.com/v1/gamecenter/", gid, "/boxscore") req <- httr2::request(url) |> httr2::req_cache(tempdir()) |> diff --git a/R/nhl-dixon-coles-fit.R b/R/nhl-dixon-coles-fit.R index 034e4e6c..63fb79a3 100644 --- a/R/nhl-dixon-coles-fit.R +++ b/R/nhl-dixon-coles-fit.R @@ -30,9 +30,9 @@ getM <- function( scores <- scores[scores$Date >= (currentDate - 4000), ] # auto-trim to ~11 years of data, past then the model doesn't get better, just bigger # Derive per-season start dates when cross-season discounting is active - season_start_dates <- if (nu != 0) derive_season_starts(scores$Date) else NULL + season_start_dates <- if (nu != 0) .derive_season_starts(scores$Date) else NULL - weights <- DCweights( + weights <- .DCweights( dates = scores$Date, currentDate = currentDate, xi = xi, @@ -66,7 +66,7 @@ getM <- function( start = rep(0.01, length(unique(df.indep$Team)) * 2), model = FALSE ) - m <- cleanModel(m) # reduce M size + m <- .cleanModel(m) # reduce M size return(m) } @@ -87,8 +87,8 @@ getRho <- function(m = HockeyModel::m, scores = HockeyModel::scores) { away.expected <- as.vector(expected[(nrow(scores) + 1):(nrow(scores) * 2)]) weights <- m$data$Weight[seq_len(nrow(scores))] - DCoptimRhoFn.fast <- function(par) { - -DCRhoLogLik( + .DCoptimRhoFn.fast <- function(par) { + -.DCRhoLogLik( y1 = scores$HomeGoals, y2 = scores$AwayGoals, mu = home.expected, @@ -100,7 +100,7 @@ getRho <- function(m = HockeyModel::m, scores = HockeyModel::scores) { res <- stats::optim( par = 0, - fn = DCoptimRhoFn.fast, + fn = .DCoptimRhoFn.fast, method = "Brent", lower = -0.5, upper = 0.5 @@ -157,7 +157,7 @@ getWeibullParams <- function( TRUE ~ NA_real_ ) ) - DCoptimTheta.fast <- function(par) { + .DCoptimTheta.fast <- function(par) { beta <- par[1] eta <- par[2] k <- par[3] @@ -186,7 +186,7 @@ getWeibullParams <- function( res <- stats::optim( par = c(3, 1, 6), - fn = DCoptimTheta.fast, + fn = .DCoptimTheta.fast, lower = c(1e-6, 1e-6, -2), upper = c(10, 10, 100), # control = list(fnscale=-1), @@ -205,7 +205,7 @@ getWeibullParams <- function( #' @param rho (`double(1)`) Low-score dependence parameter. #' @returns (`double(1)`) Tau scaling factor for one score pair. #' @keywords internal -tau_singular <- function(xx, yy, lambda, mu, rho) { +.tau_singular <- function(xx, yy, lambda, mu, rho) { if (xx == 0 && yy == 0) { return(1 - (lambda * mu * rho)) } else if (xx == 0 && yy == 1) { @@ -229,7 +229,7 @@ tau_singular <- function(xx, yy, lambda, mu, rho) { #' @param rho the factor for adjustment calculations #' #' @export -tau <- Vectorize(tau_singular, c("xx", "yy", "lambda", "mu")) +tau <- Vectorize(.tau_singular, c("xx", "yy", "lambda", "mu")) #' Compute sigmoid time-decay weights for historical matches #' @@ -257,11 +257,11 @@ tau <- Vectorize(tau_singular, c("xx", "yy", "lambda", "mu")) #' @param season_start_dates (`Date` or `NULL`) A sorted vector of season start #' dates used to determine which season each game belongs to. Required when #' `nu != 0`; if `NULL` and `nu != 0` an error is raised. Obtain from -#' [derive_season_starts()]. +#' [.derive_season_starts()]. #' #' @returns (`double`) Weight per input date in `[0, 1]`. #' @keywords internal -DCweights <- function( +.DCweights <- function( dates, currentDate = Sys.Date(), xi = DC_XI_NHL, @@ -305,7 +305,7 @@ DCweights <- function( #' @param weights (`double` or `NULL`) Optional per-match weights. #' @returns (`double(1)`) Summed (optionally weighted) log-likelihood. #' @keywords internal -DCRhoLogLik <- function(y1, y2, lambda, mu, rho = 0, weights = NULL) { +.DCRhoLogLik <- function(y1, y2, lambda, mu, rho = 0, weights = NULL) { # rho=0, independence y1 home goals y2 away goals mu:expected Home, lambda: expected Away # tau can cross zero at extreme rho (e.g. tau(0,0) = 1 - lambda*mu*rho), so # clamp to a positive floor before log() to keep the likelihood well-defined @@ -335,7 +335,7 @@ DCRhoLogLik <- function(y1, y2, lambda, mu, rho = 0, weights = NULL) { #' @returns A sorted `Date` vector with one entry per season, each being the #' first game date of that season. #' @keywords internal -derive_season_starts <- function(dates, season_month_cutoff = 8L) { +.derive_season_starts <- function(dates, season_month_cutoff = 8L) { dates <- as.Date(dates) year <- as.integer(format(dates, "%Y")) month <- as.integer(format(dates, "%m")) diff --git a/R/nhl-dixon-coles-predict.R b/R/nhl-dixon-coles-predict.R index 93b1b15e..935dfa50 100644 --- a/R/nhl-dixon-coles-predict.R +++ b/R/nhl-dixon-coles-predict.R @@ -26,7 +26,7 @@ DCPredict <- function( draws = TRUE ) { params <- .parse_dc_params(params = params) - probability_matrix <- dcProbMatrix( + probability_matrix <- .dcProbMatrix( home = home, away = away, params = params, @@ -65,7 +65,7 @@ DCPredict <- function( #' @description Builds the Dixon-Coles probability matrix for each of many #' (lambda, mu) pairs at once, returning a 3D array of dimension #' `(maxgoal+1) x (maxgoal+1) x n`. Each slice `pm[,,j]` is exactly what -#' [prob_matrix] returns for the j-th game, so the per-game output is +#' [.prob_matrix] returns for the j-th game, so the per-game output is #' statistically identical to the scalar path. #' #' @param lambda (`double(n)`) Home expected goals, one value per game. @@ -74,7 +74,7 @@ DCPredict <- function( #' @param maxgoal (`integer(1)`) Maximum goals per team. #' @returns (`array`) Probability array of dim `(maxgoal+1) x (maxgoal+1) x n`. #' @keywords internal -dcProbArray <- function(lambda, mu, params, maxgoal) { +.dcProbArray <- function(lambda, mu, params, maxgoal) { params <- .parse_dc_params(params) n <- length(lambda) G <- maxgoal + 1 @@ -86,10 +86,10 @@ dcProbArray <- function(lambda, mu, params, maxgoal) { up <- upper.tri(matrix(1, G, G)) lo <- lower.tri(matrix(1, G, G)) - build_one <- function(lam, mu) { + .build_one <- function(lam, mu) { pm <- stats::dpois(idx0, lam) %*% t(stats::dpois(idx0, mu)) # Dixon-Coles tau scaling on the four low-score cells, then clamp negatives. - # Must match prob_matrix exactly: it uses matrix(c(c00,c01,c10,c11), nrow=2) + # Must match .prob_matrix exactly: it uses matrix(c(c00,c01,c10,c11), nrow=2) # (column-major), so [2,1] gets c01 (mu) and [1,2] gets c10 (lambda). pm[1, 1] <- pm[1, 1] * (1 - (lam * mu * params$rho)) pm[2, 1] <- pm[2, 1] * (1 + (mu * params$rho)) @@ -114,7 +114,7 @@ dcProbArray <- function(lambda, mu, params, maxgoal) { out <- array(0, dim = c(G, G, n)) for (j in seq_len(n)) { - out[,, j] <- build_one(lambda[j], mu[j]) + out[, , j] <- .build_one(lambda[j], mu[j]) } return(out) } @@ -124,7 +124,7 @@ dcProbArray <- function(lambda, mu, params, maxgoal) { #' @description Computes home/draw/away win probabilities for many games at #' once. The output is statistically identical to calling [DCPredict] #' per game, but avoids the per-game function-call overhead that makes -#' `todayDC()` / `remainderSeasonDC()` O(F) in function calls. +#' `.todayDC()` / `remainderSeasonDC()` O(F) in function calls. #' #' @param home (`character(n)`) Home team name per game. #' @param away (`character(n)`) Away team name per game. @@ -138,7 +138,7 @@ dcProbArray <- function(lambda, mu, params, maxgoal) { #' probability distributed proportionally. #' @returns (`matrix(n x 3)` or `matrix(n x 2)`) Probability columns. #' @keywords internal -dcPredictVectorized <- function( +.dcPredictVectorized <- function( home, away, params = NULL, @@ -151,7 +151,7 @@ dcPredictVectorized <- function( n <- length(home) # Expected goals home / away per game, with the same error recovery path as - # [dcLambda] so new or unseen teams still produce a numeric estimate. + # [.dcLambda] so new or unseen teams still produce a numeric estimate. lam <- vapply( seq_len(n), function(i) { @@ -166,7 +166,7 @@ dcPredictVectorized <- function( if (is.numeric(x)) { x } else { - DCPredictErrorRecover( + .DCPredictErrorRecover( team = home[i], opponent = away[i], homeiceadv = TRUE @@ -189,7 +189,7 @@ dcPredictVectorized <- function( if (is.numeric(x)) { x } else { - DCPredictErrorRecover( + .DCPredictErrorRecover( team = away[i], opponent = home[i], homeiceadv = FALSE @@ -208,7 +208,7 @@ dcPredictVectorized <- function( expected_mean * (1 / 3 * season_percent) } - pm <- dcProbArray(lambda = lam, mu = mu, params = params, maxgoal = maxgoal) + pm <- .dcProbArray(lambda = lam, mu = mu, params = params, maxgoal = maxgoal) # Per-game raw (home, draw, away) regulation probabilities from the matrix. hw <- apply(pm, 3, function(x) sum(x[lower.tri(x)])) @@ -256,7 +256,7 @@ dcPredictVectorized <- function( #' @param params The named list containing m, rho, beta, eta, and k. See [updateModel()] for information on the params list #' #' @return a list of $home and $away Poisson Lambda values - -dcLambda <- function(home, away, params = NULL) { +.dcLambda <- function(home, away, params = NULL) { params <- .parse_dc_params(params = params) xg <- list("home" = NA, "away" = NA) @@ -281,14 +281,14 @@ dcLambda <- function(home, away, params = NULL) { ) if (!is.numeric(xg$home)) { - xg$home <- DCPredictErrorRecover( + xg$home <- .DCPredictErrorRecover( team = home, opponent = away, homeiceadv = TRUE ) } if (!is.numeric(xg$away)) { - xg$away <- DCPredictErrorRecover( + xg$away <- .DCPredictErrorRecover( team = away, opponent = home, homeiceadv = FALSE @@ -306,8 +306,8 @@ dcLambda <- function(home, away, params = NULL) { #' @param maxgoal (`integer(1)`) Maximum goals included per team. #' @returns (`list`) Home and away expected goals. #' @keywords internal -dcxG <- function(home, away, params = NULL, maxgoal = 10) { - pm <- dcProbMatrix( +.dcxG <- function(home, away, params = NULL, maxgoal = 10) { + pm <- .dcProbMatrix( home = home, away = away, params = params, @@ -331,7 +331,7 @@ dcxG <- function(home, away, params = NULL, maxgoal = 10) { #' @param season_percent the percent complete of the season, used for regression #' #' @return a square matrix of dims 0:maxgoal with odds at each count of home goals on 'rows' and away goals on 'columns' -dcProbMatrix <- function( +.dcProbMatrix <- function( home, away, params = NULL, @@ -342,7 +342,7 @@ dcProbMatrix <- function( ) { params <- .parse_dc_params(params = params) - xg <- dcLambda(home = home, away = away, params = params) + xg <- .dcLambda(home = home, away = away, params = params) # Expected goals home lambda <- as.numeric(xg$home) @@ -358,7 +358,7 @@ dcProbMatrix <- function( expected_mean * (1 / 3 * season_percent) } - probability_matrix <- prob_matrix( + probability_matrix <- .prob_matrix( lambda = lambda, mu = mu, params = params, @@ -370,7 +370,7 @@ dcProbMatrix <- function( #' Probability Matrix #' -#' @description Given a mu, lambda, rho, and theta, generate a probability matrix. Differs from dcProbMatrix in that no regresson or solving for supplied teams happens +#' @description Given a mu, lambda, rho, and theta, generate a probability matrix. Differs from .dcProbMatrix in that no regresson or solving for supplied teams happens #' #' @param lambda home lambda #' @param mu away mu @@ -378,8 +378,8 @@ dcProbMatrix <- function( #' @param maxgoal max goals per game #' #' @return a square matrix of maxgoal:maxgoal, with all entries in `[0, 1]` and -#' summing to 1 (see [validateProbMatrix]) -prob_matrix <- function(lambda, mu, params, maxgoal) { +#' summing to 1 (see [.validateProbMatrix]) +.prob_matrix <- function(lambda, mu, params, maxgoal) { params <- .parse_dc_params(params) probability_matrix <- stats::dpois(0:maxgoal, lambda) %*% t(stats::dpois(0:maxgoal, mu)) @@ -426,7 +426,7 @@ prob_matrix <- function(lambda, mu, params, maxgoal) { # negative. Cap the diagonal so it leaves a small positive remainder for # the off-diagonal (win/loss) outcomes instead. warning( - "prob_matrix: tie-enhanced diagonal probability (", + ".prob_matrix: tie-enhanced diagonal probability (", signif(diag_sum, 4), ") reached or exceeded 1; capping to leave room for win/loss outcomes." ) @@ -450,7 +450,7 @@ prob_matrix <- function(lambda, mu, params, maxgoal) { probability_matrix )] <- probability_matrix[lower.tri(probability_matrix)] / normfact - validateProbMatrix(probability_matrix, context = "prob_matrix") + .validateProbMatrix(probability_matrix, context = ".prob_matrix") } #' DC Sample @@ -481,16 +481,16 @@ dcSample <- function( as_result = TRUE ) { params <- .parse_dc_params(params) - pm <- dcProbMatrix( + pm <- .dcProbMatrix( home = home, away = away, params = params, maxgoal = maxgoal ) - # prob_matrix() already guarantees valid probabilities (see validateProbMatrix); + # .prob_matrix() already guarantees valid probabilities (see .validateProbMatrix); # re-validate here in case pm was constructed/modified by a caller. - pm <- validateProbMatrix(pm, context = "dcSample probability matrix") + pm <- .validateProbMatrix(pm, context = "dcSample probability matrix") goals <- as.vector(arrayInd( sample(seq_along(pm), size = 1, prob = pm), @@ -504,7 +504,7 @@ dcSample <- function( otwinner <- sample( c("Home", "Away"), size = 1, - prob = extraTimeSolver( + prob = .extraTimeSolver( sum(pm[lower.tri(pm)]), sum(pm[upper.tri(pm)]), sum(diag(pm)) @@ -545,14 +545,14 @@ dcSample <- function( #' @param nsim the number of simulations in each result #' #' @return a result from 0 to 1 corresponding to \link{scores} results -dcResult <- function(lambda, mu, params = NULL, maxgoal = 8, nsim = 1) { +.dcResult <- function(lambda, mu, params = NULL, maxgoal = 8, nsim = 1) { params <- .parse_dc_params(params) - dcr <- function(lambda, mu, params, maxgoal, nsim) { + .dcr <- function(lambda, mu, params, maxgoal, nsim) { if (is.na(lambda)) { return(NA) } - pm <- prob_matrix( + pm <- .prob_matrix( lambda = lambda, mu = mu, params = params, @@ -561,7 +561,7 @@ dcResult <- function(lambda, mu, params = NULL, maxgoal = 8, nsim = 1) { homewinprob <- sum(pm[lower.tri(pm)]) awaywinprob <- sum(pm[upper.tri(pm)]) - otwinnerprob <- extraTimeSolver(homewinprob, awaywinprob, sum(diag(pm)))[ + otwinnerprob <- .extraTimeSolver(homewinprob, awaywinprob, sum(diag(pm)))[ 2:3 ] resultprob <- c( @@ -572,9 +572,9 @@ dcResult <- function(lambda, mu, params = NULL, maxgoal = 8, nsim = 1) { otwinnerprob[2] * 0.6858606, awaywinprob ) - resultprob <- validateProbMatrix( + resultprob <- .validateProbMatrix( resultprob, - context = "dcResult resultprob" + context = ".dcResult resultprob" ) results <- sample( c(1, 0.75, 0.6, 0.4, 0.25, 0), @@ -585,10 +585,10 @@ dcResult <- function(lambda, mu, params = NULL, maxgoal = 8, nsim = 1) { return(results) } - v_dcr <- Vectorize(dcr, c("lambda", "mu")) + v_dcr <- Vectorize(.dcr, c("lambda", "mu")) if (length(lambda) == 1) { - return(dcr(lambda, mu, params, maxgoal, nsim)) + return(.dcr(lambda, mu, params, maxgoal, nsim)) } else { return(as.vector(v_dcr(lambda, mu, params, maxgoal, nsim))) } @@ -605,8 +605,8 @@ dcResult <- function(lambda, mu, params = NULL, maxgoal = 8, nsim = 1) { #' @param size (`integer(1)`) Number of samples to draw. #' @returns (`numeric`) Result values encoded like `scores$Result`. #' @keywords internal -sampleResult <- function(hw, hot, hso, aso, aot, aw, size = 1) { - sr <- function(hw, hot, hso, aso, aot, aw, size) { +.sampleResult <- function(hw, hot, hso, aso, aot, aw, size = 1) { + .sr <- function(hw, hot, hso, aso, aot, aw, size) { return(sample( c(1, 0.75, 0.6, 0.4, 0.25, 0), size = size, @@ -614,10 +614,10 @@ sampleResult <- function(hw, hot, hso, aso, aot, aw, size = 1) { prob = c(hw, hot, hso, aso, aot, aw) )) } - v_sr <- Vectorize(sr, c("hw", "hot", "hso", "aso", "aot", "aw")) + v_sr <- Vectorize(.sr, c("hw", "hot", "hso", "aso", "aot", "aw")) if (size == 1) { - return(sr(hw, hot, hso, aso, aot, aw, size)) + return(.sr(hw, hot, hso, aso, aot, aw, size)) } else { return(as.vector(v_sr(hw, hot, hso, aso, aot, aw, size))) } @@ -632,14 +632,14 @@ sampleResult <- function(hw, hot, hso, aso, aot, aw, size = 1) { #' @returns (`numeric`) Probabilities for home win, home OT, home SO, away SO, #' away OT, and away win. #' @keywords internal -dcExpandedOdds <- function(lambda, mu, params = NULL, maxgoal = 8) { +.dcExpandedOdds <- function(lambda, mu, params = NULL, maxgoal = 8) { params <- .parse_dc_params(params) - dceo <- function(lambda, mu, params, maxgoal, nsim) { + .dceo <- function(lambda, mu, params, maxgoal, nsim) { if (is.na(lambda)) { return(NA) } - pm <- prob_matrix( + pm <- .prob_matrix( lambda = lambda, mu = mu, params = params, @@ -648,7 +648,7 @@ dcExpandedOdds <- function(lambda, mu, params = NULL, maxgoal = 8) { homewinprob <- sum(pm[lower.tri(pm)]) awaywinprob <- sum(pm[upper.tri(pm)]) - otwinnerprob <- extraTimeSolver(homewinprob, awaywinprob, sum(diag(pm)))[ + otwinnerprob <- .extraTimeSolver(homewinprob, awaywinprob, sum(diag(pm)))[ 2:3 ] resultprob <- c( @@ -659,16 +659,16 @@ dcExpandedOdds <- function(lambda, mu, params = NULL, maxgoal = 8) { otwinnerprob[2] * 0.6858606, awaywinprob ) - return(validateProbMatrix( + return(.validateProbMatrix( resultprob, - context = "dcExpandedOdds resultprob" + context = ".dcExpandedOdds resultprob" )) } - v_dceo <- Vectorize(dceo, c("lambda", "mu")) + v_dceo <- Vectorize(.dceo, c("lambda", "mu")) if (length(lambda) == 1) { - return(dceo(lambda, mu, params, maxgoal)) + return(.dceo(lambda, mu, params, maxgoal)) } else { return(v_dceo(lambda, mu, params, maxgoal)) } @@ -682,7 +682,7 @@ dcExpandedOdds <- function(lambda, mu, params = NULL, maxgoal = 8) { #' @param m (`glm`) Fitted Dixon-Coles model. #' @returns (`double(1)`) Fallback expected goals estimate. #' @keywords internal -DCPredictErrorRecover <- function( +.DCPredictErrorRecover <- function( team, opponent, homeiceadv = FALSE, diff --git a/R/nhl-dixon-coles-workflow.R b/R/nhl-dixon-coles-workflow.R index 037a8367..5b34350a 100644 --- a/R/nhl-dixon-coles-workflow.R +++ b/R/nhl-dixon-coles-workflow.R @@ -14,7 +14,7 @@ #' @param upsilon (`double(1)`) Logistic midpoint (days) for within-season #' time-decay weighting. Defaults to [DC_UPSILON_NHL]. #' @param nu (`double(1)`) Cross-season discounting exponent. `0` (default -#' [DC_NU_NHL]) disables cross-season discounting. See [DCweights()] for +#' [DC_NU_NHL]) disables cross-season discounting. See [.DCweights()] for #' details. #' @param save_data (`logical(1)`) If `TRUE` and `usethis` is installed, writes #' the parameters as package data objects. @@ -69,7 +69,7 @@ #' @param draws whether to report draws in odds (AwayWin/HomeWin/Draw) or not (AwayWin/HomeWin). Default True #' #' @return a data frame of HomeTeam, AwayTeam, HomeWin, AwayWin, Draw, GameID; or NULL if no games today -todayDC <- function( +.todayDC <- function( params = NULL, today = Sys.Date(), schedule = HockeyModel::schedule, @@ -82,7 +82,7 @@ todayDC <- function( cli::cli_abort("{.arg today} must be a Date or date-like value.") } params <- .parse_dc_params(params) - #games <- games_today(date = today) + # games <- games_today(date = today) games <- schedule[schedule$Date == today, ] if (nrow(games) == 0) { return(NULL) @@ -102,7 +102,7 @@ todayDC <- function( } # Compute all games' odds at once via the vectorized path. - odds <- dcPredictVectorized( + odds <- .dcPredictVectorized( home = preds$HomeTeam, away = preds$AwayTeam, params = params, @@ -121,7 +121,7 @@ todayDC <- function( if (include_xG) { for (i in seq_len(nrow(preds))) { - xg <- dcxG( + xg <- .dcxG( home = preds$HomeTeam[[i]], away = preds$AwayTeam[[i]], params = params @@ -187,12 +187,12 @@ remainderSeasonDC <- function( ) { pred_list <- list() - cores <- parseCores(cores) + cores <- .parseCores(cores) params <- .parse_dc_params(params = params) last_game_date <- as.Date(max(scores$Date)) - schedule <- add_postponed_to_schedule_end(schedule) + schedule <- .add_postponed_to_schedule_end(schedule) schedule <- schedule[schedule$Date > last_game_date, ] schedule <- schedule |> dplyr::arrange(.data$Date, .data$GameID) @@ -232,7 +232,7 @@ remainderSeasonDC <- function( season_length } - preds <- todayDC( + preds <- .todayDC( today = d, schedule = schedule, season_percent = season_percent, @@ -243,7 +243,7 @@ remainderSeasonDC <- function( pred_list <- c(pred_list, list(preds)) } - #odds_table$Date <- schedule$Date + # odds_table$Date <- schedule$Date if (length(pred_list) == 0) { odds_table <- data.frame( HomeTeam = character(), @@ -299,14 +299,14 @@ remainderSeasonDC <- function( ) if (!is.numeric(lambda)) { - lambda <- DCPredictErrorRecover( + lambda <- .DCPredictErrorRecover( team = odds_table$HomeTeam[g], opponent = odds_table$AwayTeam[g], homeiceadv = TRUE ) } if (!is.numeric(mu)) { - mu <- DCPredictErrorRecover( + mu <- .DCPredictErrorRecover( team = odds_table$AwayTeam[g], opponent = odds_table$HomeTeam[g], homeiceadv = FALSE @@ -371,7 +371,7 @@ dcPredictMultipleDays <- function( if (!dir.exists(filedir)) { dir.create(filedir, recursive = TRUE) } - cores <- parseCores(cores) + cores <- .parseCores(cores) if (!is.Date(start)) { cli::cli_abort("{.arg start} must be a Date or date-like value.") @@ -382,7 +382,7 @@ dcPredictMultipleDays <- function( predict_dates <- seq(from = as.Date(end), to = as.Date(start), by = -1) # do it backwards to get the most recent date done first schedule$Date <- as.Date(schedule$Date) - schedule <- add_postponed_to_schedule_end(schedule) + schedule <- .add_postponed_to_schedule_end(schedule) message("Running predictions for ", length(predict_dates), " day(s).") for (day in predict_dates) { @@ -543,7 +543,7 @@ predictMultipleDaysResultsDC <- function( params$eta <- w.day$eta params$k <- w.day$k - p <- todayDC(today = d, params = params) + p <- .todayDC(today = d, params = params) sched[sched$Date == d, "HomeWin"] <- p$HomeWin sched[sched$Date == d, "AwayWin"] <- p$AwayWin diff --git a/R/nhl-league-playoffs.R b/R/nhl-league-playoffs.R index d1f5c47d..689b3826 100644 --- a/R/nhl-league-playoffs.R +++ b/R/nhl-league-playoffs.R @@ -266,10 +266,10 @@ simulatePlayoffs <- function( params = NULL ) { params <- .parse_dc_params(params) - cores <- parseCores(cores) + cores <- .parseCores(cores) # TODO use compile_predictions for this? if (is.null(summary_results)) { - pdates <- get_prediction_dates(getOption("HockeyModel.prediction.path")) + pdates <- .get_prediction_dates(getOption("HockeyModel.prediction.path")) if (length(pdates) == 0L) { cli::cli_alert_info( "No prediction files found; skipping playoff simulation." @@ -291,8 +291,8 @@ simulatePlayoffs <- function( summary_results <- summary_results |> dplyr::mutate( - "Conf" = getTeamConferences(.data$Team), - "Div" = getTeamDivisions(.data$Team) + "Conf" = .getTeamConferences(.data$Team), + "Div" = .getTeamDivisions(.data$Team) ) if ("p_rank3" %in% names(summary_results)) { # Shortcut for having prank3, 4, 5, 6 instead of prank34, and prank56. add them @@ -305,7 +305,7 @@ simulatePlayoffs <- function( east_results <- summary_results |> dplyr::filter(.data$Conf == "Eastern") west_results <- summary_results |> dplyr::filter(.data$Conf == "Western") - homeAwayOdds <- getAllHomeAwayOdds(summary_results$Team, params = params) + homeAwayOdds <- .getAllHomeAwayOdds(summary_results$Team, params = params) simresults <- data.frame( "SimNo" = integer(), @@ -369,7 +369,7 @@ simulatePlayoffs <- function( "SeriesID" = integer() ) } else { - completedSeries <- getCompletedSeries(currentSeries) + completedSeries <- .getCompletedSeries(currentSeries) for (s in currentSeries[currentSeries$Status == "Ongoing", ]$SeriesID) { homeAwayOdds[ homeAwayOdds$HomeTeam == @@ -387,7 +387,7 @@ simulatePlayoffs <- function( } } - if (cores > 1 & !requireNamespace('doSNOW', quietly = TRUE)) { + if (cores > 1 & !requireNamespace("doSNOW", quietly = TRUE)) { cli::cli_warn( "Warning: package {.pkg doSNOW} not installed. Reverting to single-core processing." ) @@ -402,19 +402,18 @@ simulatePlayoffs <- function( simresults <- foreach::foreach( i = 1:(cores * 100), .combine = "rbind" - ) %dopar% - { - simresults <- playoffSolverEngine( - nsims = ceiling(nsims / (cores * 100)), - completedSeries = completedSeries, - east_results = east_results, - west_results = west_results, - currentSeries = currentSeries, - summary_results = summary_results, - homeAwayOdds = homeAwayOdds - ) - return(simresults) - } + ) %dopar% { + simresults <- playoffSolverEngine( + nsims = ceiling(nsims / (cores * 100)), + completedSeries = completedSeries, + east_results = east_results, + west_results = west_results, + currentSeries = currentSeries, + summary_results = summary_results, + homeAwayOdds = homeAwayOdds + ) + return(simresults) + } parallel::stopCluster(cl) gc(verbose = FALSE) @@ -486,7 +485,7 @@ simulatePlayoffs <- function( #' @param p1 (`character(1)` or `NULL`) Optional forced first seed. #' @returns (`character`) Length-two vector in seeding order. #' @keywords internal -reseedTwoTeams <- function(team1, team2, summary_results, p1 = NULL) { +.reseedTwoTeams <- function(team1, team2, summary_results, p1 = NULL) { t1p <- summary_results[summary_results$Team == team1, ]$meanPoints t2p <- summary_results[summary_results$Team == team2, ]$meanPoints @@ -520,7 +519,7 @@ reseedTwoTeams <- function(team1, team2, summary_results, p1 = NULL) { #' @param params The named list containing m, rho, beta, eta, and k. See [updateModel()] for information on the params list #' #' @return a series winner (team name) -single_series_solver <- function( +.single_series_solver <- function( series_number, currentSeries, homeTeam, @@ -603,7 +602,7 @@ single_series_solver <- function( #' @param currentSeries (`data.frame`) Series table from [getAPISeries()]. #' @returns (`data.frame`) Series identifier with winner and loser teams. #' @keywords internal -getCompletedSeries <- function(currentSeries) { +.getCompletedSeries <- function(currentSeries) { completedSeries <- currentSeries |> dplyr::filter(.data$Status == "Complete") |> dplyr::mutate( @@ -745,9 +744,9 @@ playoffSolverEngine <- function( sample(seq_len(nrow(er)), size = 1, prob = er$p_rank1), ]$Team er <- er[er$Team != eastseries["p1"], ] - p1div <- getTeamDivisions(eastseries["p1"]) + p1div <- .getTeamDivisions(eastseries["p1"]) } else { - p1div <- getTeamDivisions(eastseries["p1"]) + p1div <- .getTeamDivisions(eastseries["p1"]) } if (!("p2" %in% names(eastseries))) { eastseries["p2"] <- er[er$Div == p1div, ]$Team[sample( @@ -801,7 +800,7 @@ playoffSolverEngine <- function( } if (!("series1" %in% serieslist)) { - series1 <- single_series_solver( + series1 <- .single_series_solver( series_number = 1, currentSeries = currentSeries, homeTeam = eastseries[["p1"]], @@ -818,7 +817,7 @@ playoffSolverEngine <- function( l1 <- serieslist[["l1"]] } if (!("series2" %in% serieslist)) { - series2 <- single_series_solver( + series2 <- .single_series_solver( series_number = 2, currentSeries = currentSeries, homeTeam = eastseries[["p2"]], @@ -835,7 +834,7 @@ playoffSolverEngine <- function( l2 <- serieslist[["l2"]] } if (!("series3" %in% serieslist)) { - series3 <- single_series_solver( + series3 <- .single_series_solver( series_number = 3, currentSeries = currentSeries, homeTeam = eastseries[["p3"]], @@ -852,7 +851,7 @@ playoffSolverEngine <- function( l3 <- serieslist[["l3"]] } if (!("series4" %in% serieslist)) { - series4 <- single_series_solver( + series4 <- .single_series_solver( series_number = 4, currentSeries = currentSeries, homeTeam = eastseries[["p4"]], @@ -922,9 +921,9 @@ playoffSolverEngine <- function( sample(seq_len(nrow(wr)), size = 1, prob = wr$p_rank1), ]$Team wr <- wr[wr$Team != westseries["p1"], ] - p1div <- getTeamDivisions(westseries["p1"]) + p1div <- .getTeamDivisions(westseries["p1"]) } else { - p1div <- getTeamDivisions(westseries["p1"]) + p1div <- .getTeamDivisions(westseries["p1"]) } if (!("p2" %in% names(westseries))) { westseries["p2"] <- wr[wr$Div == p1div, ]$Team[sample( @@ -978,7 +977,7 @@ playoffSolverEngine <- function( } if (!("series1" %in% serieslist)) { - series5 <- single_series_solver( + series5 <- .single_series_solver( series_number = 5, currentSeries = currentSeries, homeTeam = westseries[["p1"]], @@ -995,7 +994,7 @@ playoffSolverEngine <- function( l5 <- serieslist[["l1"]] } if (!("series2" %in% serieslist)) { - series6 <- single_series_solver( + series6 <- .single_series_solver( series_number = 6, currentSeries = currentSeries, homeTeam = westseries[["p2"]], @@ -1012,7 +1011,7 @@ playoffSolverEngine <- function( l6 <- serieslist[["l2"]] } if (!("series3" %in% serieslist)) { - series7 <- single_series_solver( + series7 <- .single_series_solver( series_number = 7, currentSeries = currentSeries, homeTeam = westseries[["p3"]], @@ -1029,7 +1028,7 @@ playoffSolverEngine <- function( l7 <- serieslist[["l3"]] } if (!("series4" %in% serieslist)) { - series8 <- single_series_solver( + series8 <- .single_series_solver( series_number = 8, currentSeries = currentSeries, homeTeam = westseries[["p4"]], @@ -1052,13 +1051,13 @@ playoffSolverEngine <- function( if ("series9" %in% completedSeries$Series) { series9 <- completedSeries[completedSeries$Series == "series9", ]$Winner } else { - rs <- reseedTwoTeams( + rs <- .reseedTwoTeams( series1, series2, summary_results, currentSeries[currentSeries$SeriesID == 1, ]$HomeTeam ) - series9 <- single_series_solver( + series9 <- .single_series_solver( series_number = 9, currentSeries = currentSeries, homeTeam = rs[1], @@ -1070,13 +1069,13 @@ playoffSolverEngine <- function( if ("series10" %in% completedSeries$Series) { series10 <- completedSeries[completedSeries$Series == "series10", ]$Winner } else { - rs <- reseedTwoTeams( + rs <- .reseedTwoTeams( series3, series4, summary_results, currentSeries[currentSeries$SeriesID == 3, ]$HomeTeam ) - series10 <- single_series_solver( + series10 <- .single_series_solver( series_number = 10, currentSeries = currentSeries, homeTeam = rs[1], @@ -1088,13 +1087,13 @@ playoffSolverEngine <- function( if ("series11" %in% completedSeries$Series) { series11 <- completedSeries[completedSeries$Series == "series11", ]$Winner } else { - rs <- reseedTwoTeams( + rs <- .reseedTwoTeams( series5, series6, summary_results, currentSeries[currentSeries$SeriesID == 5, ]$HomeTeam ) - series11 <- single_series_solver( + series11 <- .single_series_solver( series_number = 11, currentSeries = currentSeries, homeTeam = rs[1], @@ -1106,13 +1105,13 @@ playoffSolverEngine <- function( if ("series12" %in% completedSeries$Series) { series12 <- completedSeries[completedSeries$Series == "series12", ]$Winner } else { - rs <- reseedTwoTeams( + rs <- .reseedTwoTeams( series7, series8, summary_results, currentSeries[currentSeries$SeriesID == 7, ]$HomeTeam ) - series12 <- single_series_solver( + series12 <- .single_series_solver( series_number = 12, currentSeries = currentSeries, homeTeam = rs[1], @@ -1125,8 +1124,8 @@ playoffSolverEngine <- function( if ("series13" %in% completedSeries$Series) { series13 <- completedSeries[completedSeries$Series == "series13", ]$Winner } else { - rs <- reseedTwoTeams(series9, series10, summary_results) - series13 <- single_series_solver( + rs <- .reseedTwoTeams(series9, series10, summary_results) + series13 <- .single_series_solver( series_number = 13, currentSeries = currentSeries, homeTeam = rs[1], @@ -1138,8 +1137,8 @@ playoffSolverEngine <- function( if ("series14" %in% completedSeries$Series) { series14 <- completedSeries[completedSeries$Series == "series14", ]$Winner } else { - rs <- reseedTwoTeams(series11, series12, summary_results) - series14 <- single_series_solver( + rs <- .reseedTwoTeams(series11, series12, summary_results) + series14 <- .single_series_solver( series_number = 14, currentSeries = currentSeries, homeTeam = rs[1], @@ -1152,8 +1151,8 @@ playoffSolverEngine <- function( if ("series15" %in% completedSeries$Series) { series15 <- completedSeries[completedSeries$Series == "series15", ]$Winner } else { - rs <- reseedTwoTeams(series13, series14, summary_results) - series15 <- single_series_solver( + rs <- .reseedTwoTeams(series13, series14, summary_results) + series15 <- .single_series_solver( series_number = 15, currentSeries = currentSeries, homeTeam = rs[1], diff --git a/R/nhl-league-predictions-log.R b/R/nhl-league-predictions-log.R index 8fafc101..dc4e1332 100644 --- a/R/nhl-league-predictions-log.R +++ b/R/nhl-league-predictions-log.R @@ -30,7 +30,7 @@ recordTodaysPredictions <- function( if (nrow(today_sched) == 0) { stop("No games on date:", today) } - today_preds <- todayDC( + today_preds <- .todayDC( today = today, params = params, schedule = schedule, @@ -155,7 +155,7 @@ cleanupPredictionsFile <- function( #' @param draws (`logical(1)`) Whether to store draw probabilities. #' @returns (`logical(1)`) `TRUE` when processing completes. #' @keywords internal -build_past_predictions <- function( +.build_past_predictions <- function( startDate, endDate, scores = HockeyModel::scores, diff --git a/R/nhl-league-simulation.R b/R/nhl-league-simulation.R index f56e5508..08b54399 100644 --- a/R/nhl-league-simulation.R +++ b/R/nhl-league-simulation.R @@ -13,7 +13,7 @@ #' @return `list(res1 = , res2 = , Result = )` each of #' length `nrow(odds_table)`. #' @keywords internal -sim_odds_results <- function(odds_table) { +.sim_odds_results <- function(odds_table) { res1 <- stats::runif(n = nrow(odds_table)) res2 <- stats::runif(n = nrow(odds_table)) home_win <- odds_table$HomeWin @@ -47,7 +47,7 @@ sim_odds_results <- function(odds_table) { #' @return (`integer`) Vector of length `n` of chunk sizes whose sum equals #' `nsims`. #' @keywords internal -simulation_chunks <- function(nsims, n) { +.simulation_chunks <- function(nsims, n) { base <- nsims %/% n rem <- nsims %% n sizes <- rep(base, n) @@ -73,9 +73,9 @@ simulation_chunks <- function(nsims, n) { #' @return (`tibble`) Per-team stats with a `SimNo` column, one block per #' simulation in `sim_ids`. #' @keywords internal -sim_batch <- function(sim_ids, odds_table, season_sofar = NULL) { +.sim_batch <- function(sim_ids, odds_table, season_sofar = NULL) { out <- lapply(sim_ids, function(i) { - res <- sim_odds_results(odds_table) + res <- .sim_odds_results(odds_table) table <- buildStats( dplyr::bind_cols( season_sofar, @@ -121,7 +121,7 @@ simulateSeasonParallel <- function( sort(unique(c(as.character(schedule$Home), as.character(schedule$Away)))) ) - cores <- parseCores(cores) + cores <- .parseCores(cores) odds_table <- remainderSeasonDC( scores = scores, @@ -130,12 +130,12 @@ simulateSeasonParallel <- function( odds = TRUE ) - odds_table$HOT <- extraTimeSolver( + odds_table$HOT <- .extraTimeSolver( odds_table$HomeWin, odds_table$AwayWin, odds_table$Draw )[, 2] - odds_table$AOT <- extraTimeSolver( + odds_table$AOT <- .extraTimeSolver( odds_table$HomeWin, odds_table$AwayWin, odds_table$Draw @@ -145,10 +145,10 @@ simulateSeasonParallel <- function( # Worker body. doSNOW workers only see the *attached* package namespace, # so we call the exported buildStats() directly (its own closure resolves # its internal helpers correctly). The result-sampling body is inlined - # here rather than calling the internal sim_odds_results(), because + # here rather than calling the internal .sim_odds_results(), because # non-exported functions are not reliably callable from a worker. It uses # only base R + stats::runif, so it runs identically in a worker. - run_sim_batch <- function(sim_ids, odds_table, season_sofar) { + .run_sim_batch <- function(sim_ids, odds_table, season_sofar) { home_win <- odds_table$HomeWin hot <- odds_table$HOT aot <- odds_table$AOT @@ -192,7 +192,7 @@ simulateSeasonParallel <- function( # Run `nsims` simulations across `cores` batched tasks rather than one task # per simulation, so the invariant odds_table is serialised to each worker # only `cores` times instead of `nsims` times (#49). - chunk_sizes <- simulation_chunks(nsims, cores) + chunk_sizes <- .simulation_chunks(nsims, cores) # Assign each simulation number (1..nsims) to a worker: worker i runs the # simulations whose index falls in its chunk. sim_to_worker <- rep(1:cores, times = chunk_sizes) @@ -201,11 +201,10 @@ simulateSeasonParallel <- function( .combine = "rbind", .options.snow = opts, .packages = c("HockeyModel") - ) %dopar% - { - ids <- which(sim_to_worker == i) - run_sim_batch(ids, odds_table, season_sofar) - } + ) %dopar% { + ids <- which(sim_to_worker == i) + .run_sim_batch(ids, odds_table, season_sofar) + } if (progress) { close(pb) } @@ -217,7 +216,7 @@ simulateSeasonParallel <- function( "Parallel processing is only available if the parallels package is installed." ) } - all_results <- sim_batch(1:nsims, odds_table, season_sofar) + all_results <- .sim_batch(1:nsims, odds_table, season_sofar) } summary_results <- all_results |> @@ -258,7 +257,7 @@ simulateSeasonParallel <- function( compile_predictions <- function( dir = getOption("HockeyModel.prediction.path") ) { - pdates <- get_prediction_dates(dir) + pdates <- .get_prediction_dates(dir) if (length(pdates) == 0L) { cli::cli_abort("No prediction files found in {.path {dir}}.") } @@ -297,11 +296,11 @@ loopless_sim <- function( ) { params <- .parse_dc_params(params) - cores <- parseCores(cores) + cores <- .parseCores(cores) schedule <- schedule[!(schedule$GameID %in% scores$GameID), ] - schedule <- add_postponed_to_schedule_end(schedule) + schedule <- .add_postponed_to_schedule_end(schedule) if ( is.null(odds_table) || @@ -347,7 +346,7 @@ loopless_sim <- function( all_season$Result <- NA } - oddsseason <- extraTimeSolver( + oddsseason <- .extraTimeSolver( all_season$HomeWin, all_season$AwayWin, 1 - (all_season$HomeWin + all_season$AwayWin) @@ -383,19 +382,18 @@ loopless_sim <- function( # tasks each ran `ceiling(nsims / 100)` simulations, so the total rarely # matched `nsims`). Each task also runs many simulations before returning, # reducing serialisation round-trips (#51, #49). - chunk_sizes <- simulation_chunks(nsims, cores) + chunk_sizes <- .simulation_chunks(nsims, cores) all_results <- foreach::foreach( i = seq_len(cores), .combine = "rbind", .packages = "HockeyModel" - ) %dopar% - { - sim_engine( - all_season = all_season, - nsims = chunk_sizes[i], - params = params - ) - } + ) %dopar% { + sim_engine( + all_season = all_season, + nsims = chunk_sizes[i], + params = params + ) + } parallel::stopCluster(cl) gc(verbose = FALSE) @@ -486,7 +484,7 @@ sim_engine <- function(all_season, nsims, params = NULL) { for (i in seq_len(season_length)) { if (is_unplayed[i]) { - r <- sampleResult( + r <- .sampleResult( hw[i], hot[i], hso[i], @@ -513,7 +511,7 @@ sim_engine <- function(all_season, nsims, params = NULL) { ) # Sum a boolean mask over the games a team plays (home or away) - sum_mask <- function(games_idx, res_list, value) { + .sum_mask <- function(games_idx, res_list, value) { if (length(games_idx) == 0L) { return(rep(0, nsims)) } @@ -533,48 +531,48 @@ sim_engine <- function(all_season, nsims, params = NULL) { # an away win (away_res == 1) corresponds to home_res == 0. all_results$W <- unlist(mapply( function(t) { - sum_mask(home_games[[t]], home_res, 1) + - sum_mask(away_games[[t]], away_res, 1) + .sum_mask(home_games[[t]], home_res, 1) + + .sum_mask(away_games[[t]], away_res, 1) }, seq_along(teamlist), SIMPLIFY = FALSE )) all_results$OTW <- unlist(mapply( function(t) { - sum_mask(home_games[[t]], home_res, 0.75) + - sum_mask(away_games[[t]], away_res, 0.75) + .sum_mask(home_games[[t]], home_res, 0.75) + + .sum_mask(away_games[[t]], away_res, 0.75) }, seq_along(teamlist), SIMPLIFY = FALSE )) all_results$SOW <- unlist(mapply( function(t) { - sum_mask(home_games[[t]], home_res, 0.6) + - sum_mask(away_games[[t]], away_res, 0.6) + .sum_mask(home_games[[t]], home_res, 0.6) + + .sum_mask(away_games[[t]], away_res, 0.6) }, seq_along(teamlist), SIMPLIFY = FALSE )) all_results$L <- unlist(mapply( function(t) { - sum_mask(home_games[[t]], home_res, 0) + - sum_mask(away_games[[t]], away_res, 0) + .sum_mask(home_games[[t]], home_res, 0) + + .sum_mask(away_games[[t]], away_res, 0) }, seq_along(teamlist), SIMPLIFY = FALSE )) all_results$OTL <- unlist(mapply( function(t) { - sum_mask(home_games[[t]], home_res, 0.25) + - sum_mask(away_games[[t]], away_res, 0.25) + .sum_mask(home_games[[t]], home_res, 0.25) + + .sum_mask(away_games[[t]], away_res, 0.25) }, seq_along(teamlist), SIMPLIFY = FALSE )) all_results$SOL <- unlist(mapply( function(t) { - sum_mask(home_games[[t]], home_res, 0.4) + - sum_mask(away_games[[t]], away_res, 0.4) + .sum_mask(home_games[[t]], home_res, 0.4) + + .sum_mask(away_games[[t]], away_res, 0.4) }, seq_along(teamlist), SIMPLIFY = FALSE @@ -587,8 +585,8 @@ sim_engine <- function(all_season, nsims, params = NULL) { all_results$OTL + all_results$SOL - all_results$Conference <- unlist(getTeamConferences(all_results$Team)) - all_results$Division <- getTeamDivisions(all_results$Team) + all_results$Conference <- unlist(.getTeamConferences(all_results$Team)) + all_results$Division <- .getTeamDivisions(all_results$Team) all_results$Wildcard <- 100 all_results <- all_results |> @@ -659,7 +657,7 @@ todayOdds <- function( season_percent = NULL, include_xG = FALSE ) { - return(todayDC( + return(.todayDC( params = params, today = today, schedule = schedule, @@ -676,7 +674,7 @@ todayOdds <- function( #' @param params (`list` or `NULL`) Dixon-Coles parameter list. #' @returns (`data.frame`) Pairwise table with `HomeOdds`. #' @keywords internal -getAllHomeAwayOdds <- function(teamlist, params = NULL) { +.getAllHomeAwayOdds <- function(teamlist, params = NULL) { params <- .parse_dc_params(params) homeAwayOdds <- expand.grid( "HomeTeam" = teamlist, diff --git a/R/nhl-league-standings.R b/R/nhl-league-standings.R index 312da6aa..f0121b4d 100644 --- a/R/nhl-league-standings.R +++ b/R/nhl-league-standings.R @@ -110,8 +110,8 @@ buildStats <- function(scores) { -.data$ROSW, .data$Rand )), # include Random for random ties sorting, else Anaheim will always beat Vegas if they're tied. - Conf = getTeamConferences(.data$Team), # convenience data, dropped later - Div = getTeamDivisions(.data$Team) + Conf = .getTeamConferences(.data$Team), # convenience data, dropped later + Div = .getTeamDivisions(.data$Team) ) |> dplyr::group_by(.data$Conf) |> dplyr::mutate(ConfRank = rank(.data$Rank, ties.method = "random")) |> diff --git a/R/nhl-team-season-lookup.R b/R/nhl-team-season-lookup.R index db28feb8..f4545519 100644 --- a/R/nhl-team-season-lookup.R +++ b/R/nhl-team-season-lookup.R @@ -193,7 +193,7 @@ getSeason <- function(gamedate = Sys.Date()) { httr2::resp_body_string() |> jsonlite::fromJSON() seasons <- seasons$data - gs <- function(gd, seasons) { + .gs <- function(gd, seasons) { gd <- as.Date(gd) season_list <- seasons[seasons$startDate <= gd & seasons$endDate >= gd, ] if (nrow(season_list) == 1) { @@ -202,10 +202,10 @@ getSeason <- function(gamedate = Sys.Date()) { return(NULL) } } - vgs <- Vectorize(FUN = gs, vectorize.args = c("gd")) + vgs <- Vectorize(FUN = .gs, vectorize.args = c("gd")) if (length(gamedate) == 1) { - return(gs(gd = gamedate, seasons = seasons)) + return(.gs(gd = gamedate, seasons = seasons)) } else if (length(gamedate) > 1) { return(unname(vgs(gd = gamedate, seasons = seasons))) } @@ -218,7 +218,7 @@ getSeason <- function(gamedate = Sys.Date()) { #' column. #' @returns (`character`) Unique conference names. #' @keywords internal -getConferences <- function(teamColours = HockeyModel::teamColours) { +.getConferences <- function(teamColours = HockeyModel::teamColours) { return(unique(teamColours$Conference)) } @@ -228,7 +228,7 @@ getConferences <- function(teamColours = HockeyModel::teamColours) { #' column. #' @returns (`character`) Unique division names. #' @keywords internal -getDivisions <- function(teamColours = HockeyModel::teamColours) { +.getDivisions <- function(teamColours = HockeyModel::teamColours) { return(unique(teamColours$Division)) } @@ -238,15 +238,15 @@ getDivisions <- function(teamColours = HockeyModel::teamColours) { #' @param teamColours (`data.frame`) Team metadata table. #' @returns (`character`) Conference name for each input team. #' @keywords internal -getTeamConferences <- function(teams, teamColours = HockeyModel::teamColours) { - getteamconf <- function(t, teamColours = HockeyModel::teamColours) { +.getTeamConferences <- function(teams, teamColours = HockeyModel::teamColours) { + .getteamconf <- function(t, teamColours = HockeyModel::teamColours) { return(teamColours[teamColours$Team == t, ]$Conference) } - v_getteamconf <- Vectorize(getteamconf, "t") - teams <- clean_names(teams) + v_getteamconf <- Vectorize(.getteamconf, "t") + teams <- .clean_names(teams) if (length(teams) == 1) { - return(getteamconf(t = teams, teamColours = teamColours)) + return(.getteamconf(t = teams, teamColours = teamColours)) } else { return(unname(v_getteamconf(t = teams, teamColours = teamColours))) } @@ -258,15 +258,15 @@ getTeamConferences <- function(teams, teamColours = HockeyModel::teamColours) { #' @param teamColours (`data.frame`) Team metadata table. #' @returns (`character`) Division name for each input team. #' @keywords internal -getTeamDivisions <- function(teams, teamColours = HockeyModel::teamColours) { - getteamdiv <- function(t, teamColours = HockeyModel::teamColours) { +.getTeamDivisions <- function(teams, teamColours = HockeyModel::teamColours) { + .getteamdiv <- function(t, teamColours = HockeyModel::teamColours) { return(teamColours[teamColours$Team == t, ]$Division) } - v_getteamdiv <- Vectorize(getteamdiv, "t") - teams <- clean_names(teams) + v_getteamdiv <- Vectorize(.getteamdiv, "t") + teams <- .clean_names(teams) if (length(teams) == 1) { - return(getteamdiv(t = teams, teamColours = teamColours)) + return(.getteamdiv(t = teams, teamColours = teamColours)) } else { return(unname(v_getteamdiv(t = teams, teamColours = teamColours))) } @@ -278,8 +278,8 @@ getTeamDivisions <- function(teams, teamColours = HockeyModel::teamColours) { #' @param teamColours (`data.frame`) Team metadata table. #' @returns (`character`) Team short code for each input team. #' @keywords internal -getShortTeam <- function(teams, teamColours = HockeyModel::teamColours) { - getteamshort <- function(t) { +.getShortTeam <- function(teams, teamColours = HockeyModel::teamColours) { + .getteamshort <- function(t) { if (t %in% teamColours$Team) { return(teamColours[teamColours$Team == t, ]$ShortCode) } else { @@ -287,10 +287,10 @@ getShortTeam <- function(teams, teamColours = HockeyModel::teamColours) { } } - v_getteamshort <- Vectorize(getteamshort, "t") - teams <- clean_names(teams) + v_getteamshort <- Vectorize(.getteamshort, "t") + teams <- .clean_names(teams) if (length(teams) == 1) { - return(getteamshort(t = teams)) + return(.getteamshort(t = teams)) } else { return(unname(v_getteamshort(t = teams))) } @@ -302,8 +302,8 @@ getShortTeam <- function(teams, teamColours = HockeyModel::teamColours) { #' @param teamColours (`data.frame`) Team metadata table. #' @returns (`character`) Long-form team name for each input code. #' @keywords internal -getLongTeam <- function(teams, teamColours = HockeyModel::teamColours) { - getteamlong <- function(t) { +.getLongTeam <- function(teams, teamColours = HockeyModel::teamColours) { + .getteamlong <- function(t) { if (t %in% teamColours$ShortCode) { return(teamColours[teamColours$ShortCode == t, ]$Team) } else { @@ -311,10 +311,10 @@ getLongTeam <- function(teams, teamColours = HockeyModel::teamColours) { } } - v_getteamlong <- Vectorize(getteamlong, "t") - teams <- clean_names(teams) + v_getteamlong <- Vectorize(.getteamlong, "t") + teams <- .clean_names(teams) if (length(teams) == 1) { - return(getteamlong(t = teams)) + return(.getteamlong(t = teams)) } else { return(unname(v_getteamlong(t = teams))) } @@ -325,9 +325,9 @@ getLongTeam <- function(teams, teamColours = HockeyModel::teamColours) { #' @param season (`character(1)`) Season ID in eight-digit format. #' @returns (`numeric(1)`) Number of regular-season games per team. #' @keywords internal -getNumGames <- function(season = getCurrentSeason8()) { +.getNumGames <- function(season = getCurrentSeason8()) { if (!is.null(season)) { - if (!seasonValidator(season)) { + if (!.seasonValidator(season)) { cli::cli_abort( "{.arg season} must be a valid NHL season ID (e.g. {.val 20202021})." ) diff --git a/R/package-setup.R b/R/package-setup.R index b73272e5..b34e3a36 100644 --- a/R/package-setup.R +++ b/R/package-setup.R @@ -5,7 +5,7 @@ #' @param cores (`integer(1)` or `NULL`) Requested core count. #' @returns (`integer(1)`) Core count constrained to available resources. #' @keywords internal -parseCores <- function(cores) { +.parseCores <- function(cores) { cores <- cores if (is.null(cores)) { if (!requireNamespace("parallel", quietly = TRUE)) { @@ -103,7 +103,7 @@ parseCores <- function(cores) { #' #' @return A (possibly empty) sorted `Date` vector. #' @keywords internal -get_prediction_dates <- function( +.get_prediction_dates <- function( dir = getOption("HockeyModel.prediction.path") ) { if (is.null(dir) || !dir.exists(dir)) { diff --git a/R/pwhl-api-fetch.R b/R/pwhl-api-fetch.R index bc99e12f..2c9756d6 100644 --- a/R/pwhl-api-fetch.R +++ b/R/pwhl-api-fetch.R @@ -10,7 +10,7 @@ PWHL_API_CLIENT <- "pwhl" #' @param params Named list of query parameters to append. #' @returns A prepared [`httr2::request`] object. #' @keywords internal -pwhl_api_request <- function(params) { +.pwhl_api_request <- function(params) { all_params <- c( params, list(key = PWHL_API_KEY, client_code = PWHL_API_CLIENT) @@ -33,7 +33,7 @@ pwhl_api_request <- function(params) { #' @export getPWHLSeasons <- function() { resp <- tryCatch( - pwhl_api_request(list(feed = "modulekit", view = "seasons")) |> + .pwhl_api_request(list(feed = "modulekit", view = "seasons")) |> httr2::req_perform() |> httr2::resp_body_string() |> jsonlite::fromJSON(), @@ -116,7 +116,7 @@ getPWHLSchedule <- function( season <- as.integer(season) resp <- tryCatch( - pwhl_api_request( + .pwhl_api_request( list(feed = "modulekit", view = "schedule", season_id = season) ) |> httr2::req_perform() |> @@ -156,8 +156,8 @@ getPWHLSchedule <- function( sched <- data.frame( Date = as.Date(games$date_played), - HomeTeam = getLongTeam(games$home_team_code, pwhlTeamColours), - AwayTeam = getLongTeam(games$visiting_team_code, pwhlTeamColours), + HomeTeam = .getLongTeam(games$home_team_code, pwhlTeamColours), + AwayTeam = .getLongTeam(games$visiting_team_code, pwhlTeamColours), GameID = as.integer(games$id), GameType = game_type, GameStatus = ifelse( @@ -216,7 +216,7 @@ getPWHLScores <- function( scores <- NULL for (gid in gameIDs) { sc <- tryCatch( - pwhl_game_summary(gid), + .pwhl_game_summary(gid), error = function(e) { message("Error retrieving PWHL game ", gid, ": ", conditionMessage(e)) NULL @@ -244,11 +244,11 @@ getPWHLScores <- function( #' @param pwhlTeamColours Built-in PWHL Team Colours data #' @returns (`character(1)`) Canonical team name. #' @keywords internal -pwhl_resolve_team_name <- function( +.pwhl_resolve_team_name <- function( pwhlID, pwhlTeamColours = HockeyModel::pwhlTeamColours ) { - getteamname <- function(t) { + .getteamname <- function(t) { if (t %in% pwhlTeamColours$PWHLID) { return(pwhlTeamColours[pwhlTeamColours$PWHLID == t, ]$Team) } else { @@ -256,9 +256,9 @@ pwhl_resolve_team_name <- function( } } - v_getteamname <- Vectorize(getteamname, "t") + v_getteamname <- Vectorize(.getteamname, "t") if (length(pwhlID) == 1) { - return(getteamname(t = pwhlID)) + return(.getteamname(t = pwhlID)) } else { return(unname(v_getteamname(t = pwhlID))) } @@ -270,9 +270,9 @@ pwhl_resolve_team_name <- function( #' @param gid (`integer(1)`) PWHL game ID. #' @returns A one-row data frame or `NULL` if the game is not final. #' @keywords internal -pwhl_game_summary <- function(gid) { +.pwhl_game_summary <- function(gid) { resp <- tryCatch( - pwhl_api_request( + .pwhl_api_request( list(feed = "gc", tab = "gamesummary", game_id = gid, lang = "en") ) |> httr2::req_perform() |> @@ -288,33 +288,33 @@ pwhl_game_summary <- function(gid) { return(NULL) } - gs <- resp$GC$Gamesummary - if (is.null(gs)) { + .gs <- resp$GC$Gamesummary + if (is.null(.gs)) { return(NULL) } - meta <- gs$meta + meta <- .gs$meta # Only process finished games if (is.null(meta) || is.null(meta$status) || meta$status != "4") { return(NULL) } - home_goals <- gs$goalCount$home - away_goals <- gs$goalCount$visitor + home_goals <- .gs$goalCount$home + away_goals <- .gs$goalCount$visitor n_periods <- meta$period ot_status <- if (n_periods == 3L) { "" } else if (n_periods == 4L) { # Check for shootout - shootout <- gs$shootoutDetail + shootout <- .gs$shootoutDetail if (!is.null(shootout) && length(shootout) > 0) "SO" else "OT" } else { "OT" } - home_team <- getLongTeam(gs$home$team_code, HockeyModel::pwhlTeamColours) - away_team <- getLongTeam(gs$visitor$team_code, HockeyModel::pwhlTeamColours) + home_team <- .getLongTeam(.gs$home$team_code, HockeyModel::pwhlTeamColours) + away_team <- .getLongTeam(.gs$visitor$team_code, HockeyModel::pwhlTeamColours) sched <- HockeyModel::pwhlSchedule gt <- sched[sched$GameID == gid, ]$GameType @@ -475,7 +475,7 @@ getPWHLPlayoffSeries <- function(season_id = NULL) { # Build API request for brackets resp <- tryCatch( - pwhl_api_request(list( + .pwhl_api_request(list( feed = "modulekit", view = "brackets", season_id = season_id @@ -483,7 +483,9 @@ getPWHLPlayoffSeries <- function(season_id = NULL) { httr2::req_perform() |> httr2::resp_body_string() |> jsonlite::fromJSON(), - error = function(e) return(NULL) + error = function(e) { + return(NULL) + } ) if (is.null(resp) || is.null(resp$SiteKit$Brackets)) { return(NULL) @@ -499,8 +501,8 @@ getPWHLPlayoffSeries <- function(season_id = NULL) { # Flatten all rounds/series series_list <- data.frame( - HomeTeam = pwhl_resolve_team_name(matchups[[1]]$team1), - AwayTeam = pwhl_resolve_team_name(matchups[[1]]$team2), + HomeTeam = .pwhl_resolve_team_name(matchups[[1]]$team1), + AwayTeam = .pwhl_resolve_team_name(matchups[[1]]$team2), HomeWins = as.integer(matchups[[1]]$team1_wins), AwayWins = as.integer(matchups[[1]]$team2_wins) ) @@ -521,7 +523,7 @@ getPWHLPlayoffSeries <- function(season_id = NULL) { #' @returns `NULL` (invisibly). Writes updated data when `usethis` is #' available. #' @keywords internal -buildPWHLTeamColours <- function() { +.buildPWHLTeamColours <- function() { pwhlTeamColours <- utils::read.csv( "./data-raw/logos/pwhl_team_colours.csv", stringsAsFactors = FALSE diff --git a/R/pwhl-daily-summary.R b/R/pwhl-daily-summary.R index a8f2ac3b..3a58e7f5 100644 --- a/R/pwhl-daily-summary.R +++ b/R/pwhl-daily-summary.R @@ -19,7 +19,7 @@ model_data <- .update_model_pwhl() schedule <- model_data$schedule scores <- model_data$scores - params <- parse_pwhl_dc_params(model_data$params) + params <- .parse_pwhl_dc_params(model_data$params) if (nrow(schedule) == 0 || Sys.Date() > max(schedule$Date)) { cli::cli_alert_info("No PWHL games scheduled; nothing to do.") diff --git a/R/pwhl-model-core.R b/R/pwhl-model-core.R index fd39645a..97b705dd 100644 --- a/R/pwhl-model-core.R +++ b/R/pwhl-model-core.R @@ -12,7 +12,7 @@ #' #' @returns The same data frame with an added `Result` column. #' @keywords internal -pwhl_add_result <- function(scores) { +.pwhl_add_result <- function(scores) { scores$Result <- dplyr::case_when( scores$HomeGoals > scores$AwayGoals & scores$OTStatus == "" ~ 1, scores$HomeGoals > scores$AwayGoals & scores$OTStatus == "OT" ~ 0.75, @@ -42,7 +42,7 @@ pwhl_add_result <- function(scores) { #' time-decay weighting. Defaults to [DC_UPSILON_PWHL]. #' @param nu (`double(1)`) Cross-season discounting exponent. Defaults to #' [DC_NU_PWHL] (2), which provides moderate discounting of older seasons to -#' account for PWHL expansion-draft roster churn. See [DCweights()] for +#' account for PWHL expansion-draft roster churn. See [.DCweights()] for #' details. #' @param save_data (`logical(1)`) If `TRUE` and `usethis` is installed, writes #' the parameters as package data objects. @@ -71,7 +71,7 @@ pwhl_add_result <- function(scores) { cli::cli_abort("No finalised PWHL games found in {.arg scores}.") } - scores <- pwhl_add_result(scores) + scores <- .pwhl_add_result(scores) if (currentDate != Sys.Date()) { currentDate <- as.Date(currentDate) @@ -129,7 +129,7 @@ pwhl_add_result <- function(scores) { #' #' @returns A named list with elements `m`, `rho`, `beta`, `eta`, and `k`. #' @keywords internal -parse_pwhl_dc_params <- function(params = NULL) { +.parse_pwhl_dc_params <- function(params = NULL) { .parse_dc_params( params, defaults = list( @@ -210,7 +210,7 @@ pwhl_in_season <- function( #' #' @returns (`Date`) First game date in the schedule, or `NA` if empty. #' @keywords internal -pwhl_season_start_date <- function(schedule = HockeyModel::pwhlSchedule) { +.pwhl_season_start_date <- function(schedule = HockeyModel::pwhlSchedule) { if (nrow(schedule) == 0) { return(as.Date(NA_character_)) } @@ -250,10 +250,10 @@ pwhl_loopless_sim <- function( params = NULL, odds_table = NULL ) { - params <- parse_pwhl_dc_params(params) + params <- .parse_pwhl_dc_params(params) scores_rs <- scores[scores$GameType == "R", ] - season_start <- pwhl_season_start_date(schedule) + season_start <- .pwhl_season_start_date(schedule) if (is.na(season_start)) { cli::cli_abort( @@ -281,7 +281,7 @@ pwhl_loopless_sim <- function( } season_sofar <- scores_rs[scores_rs$Date >= season_start, ] - season_sofar <- pwhl_add_result(season_sofar) + season_sofar <- .pwhl_add_result(season_sofar) # Drop any rows with missing Result (should not occur in clean data) season_sofar <- season_sofar[!is.na(season_sofar$Result), ] @@ -308,7 +308,7 @@ pwhl_loopless_sim <- function( all_season$AwayOT <- NA_real_ if (any(future_mask)) { - ot_probs <- extraTimeSolver( + ot_probs <- .extraTimeSolver( all_season$HomeWin[future_mask], all_season$AwayWin[future_mask], 1 - (all_season$HomeWin[future_mask] + all_season$AwayWin[future_mask]) @@ -356,7 +356,7 @@ pwhl_loopless_sim <- function( c("HomeWin", "HomeOT", "HomeSO", "AwaySO", "AwayOT", "AwayWin") ], function(HomeWin, HomeOT, HomeSO, AwaySO, AwayOT, AwayWin, ...) { - sampleResult( + .sampleResult( HomeWin, HomeOT, HomeSO, diff --git a/R/tune_weights.R b/R/tune_weights.R index 28cff92d..11984485 100644 --- a/R/tune_weights.R +++ b/R/tune_weights.R @@ -11,7 +11,7 @@ #' # NHL #' optim( #' par = c(DC_XI_NHL, DC_UPSILON_NHL, DC_NU_NHL), -#' fn = function(p) tune_dc_weight(xi = p[1], upsilon = p[2], nu = p[3]), +#' fn = function(p) .tune_dc_weight(xi = p[1], upsilon = p[2], nu = p[3]), #' method = "L-BFGS-B", #' lower = c(1e-4, 30, 0), #' upper = c(0.05, 730, 5) @@ -20,7 +20,7 @@ #' # PWHL #' optim( #' par = c(DC_XI_PWHL, DC_UPSILON_PWHL, DC_NU_PWHL), -#' fn = function(p) tune_dc_weight(p[1], p[2], p[3], league = "PWHL"), +#' fn = function(p) .tune_dc_weight(p[1], p[2], p[3], league = "PWHL"), #' method = "L-BFGS-B", #' lower = c(1e-4, 30, 0), #' upper = c(0.05, 730, 5), @@ -41,7 +41,7 @@ #' @returns (`double(1)`) Log-loss on the held-out test period (lower is #' better). #' @keywords internal -tune_dc_weight <- function( +.tune_dc_weight <- function( xi = NULL, upsilon = NULL, nu = NULL, @@ -61,9 +61,9 @@ tune_dc_weight <- function( "No PWHL scores available. Run {.fn updatePWHLScoresAPI} first." ) } - all_scores <- pwhl_add_result(all_scores) + all_scores <- .pwhl_add_result(all_scores) # Use the most recent PWHL season as the test period - season_starts <- derive_season_starts(all_scores$Date) + season_starts <- .derive_season_starts(all_scores$Date) if (length(season_starts) < 2) { cli::cli_abort( "At least two PWHL seasons of data are required to tune weights." @@ -109,7 +109,7 @@ tune_dc_weight <- function( test_dates <- sort(unique(truth$Date)) # Inner function: produce HomeWin probability for all games on date d - get_game_odds <- function(d, all_scores, xi, upsilon, nu) { + .get_game_odds <- function(d, all_scores, xi, upsilon, nu) { current_m <- getM( scores = all_scores[all_scores$Date < d, ], currentDate = d, @@ -140,7 +140,7 @@ tune_dc_weight <- function( return(sch[, c("GameID", "HomeWin", "AwayWin")]) } - cl <- parallel::makeCluster(parseCores(4)) + cl <- parallel::makeCluster(.parseCores(4)) on.exit(parallel::stopCluster(cl), add = TRUE) doSNOW::registerDoSNOW(cl) `%dopar%` <- foreach::`%dopar%` # This hack passes R CMD CHK @@ -150,7 +150,7 @@ tune_dc_weight <- function( i = seq_along(test_dates), .combine = "rbind" ) %dopar% - (get_game_odds(test_dates[i], all_scores, xi, upsilon, nu)) + (.get_game_odds(test_dates[i], all_scores, xi, upsilon, nu)) schedule <- dplyr::left_join( truth[, c("GameID", "Date", "HomeTeam", "AwayTeam", "Result")], diff --git a/R/utils-export.R b/R/utils-export.R index 5a2685ac..34990418 100644 --- a/R/utils-export.R +++ b/R/utils-export.R @@ -8,7 +8,7 @@ #' @param handle (`character(1)`) Contest handle to include in output. #' @returns (`character(1)`) Serialized contest payload string. #' @keywords internal -formatPredsForHockeyVisContest <- function( +.formatPredsForHockeyVisContest <- function( predictions, candyType = "Fuzzy Peaches", handle = "@bot.bulsink.ca" diff --git a/R/validation-helpers.R b/R/validation-helpers.R index 49e8e0ed..d3969a33 100644 --- a/R/validation-helpers.R +++ b/R/validation-helpers.R @@ -7,7 +7,7 @@ #' @param cm model to clean #' #' @return a smaller model, ready for saving -cleanModel <- function(cm) { +.cleanModel <- function(cm) { # from http://www.win-vector.com/blog/2014/05/trimming-the-fat-from-glm-models-in-r/ cm$y <- c() cm$model <- c() @@ -58,7 +58,7 @@ normalizeOdds <- function(odds) { #' @returns `x`, with any within-tolerance out-of-range values clamped into #' `[0, 1]`. #' @keywords internal -validateProbMatrix <- function( +.validateProbMatrix <- function( x, tol = 1e-6, clamp_tol = 1e-3, @@ -104,7 +104,7 @@ validateProbMatrix <- function( #' @param sc scores frame #' #' @returns A tibble with season point totals by team. -historicalPoints <- function(sc) { +.historicalPoints <- function(sc) { sc <- sc |> dplyr::rowwise() |> dplyr::mutate(Season = getSeason(.data$Date)) @@ -162,7 +162,7 @@ is.Date <- function(date) { #' @param season (`character(1)`) Candidate season ID. #' @returns (`logical(1)`) `TRUE` when `season` matches `YYYYYYYY` format. #' @keywords internal -seasonValidator <- function(season) { +.seasonValidator <- function(season) { # TODO: Currently 19272099 would pass - make sure the two years are sequential if (!is.character(season)) { return(FALSE) @@ -179,8 +179,8 @@ seasonValidator <- function(season) { #' @returns (`matrix` or `numeric`) Home regulation, home OT/SO, away OT/SO, #' and away regulation probabilities. #' @keywords internal -extraTimeSolver <- function(home_win, away_win, draw) { - ets <- function(home_win, away_win, draw) { +.extraTimeSolver <- function(home_win, away_win, draw) { + .ets <- function(home_win, away_win, draw) { homenorm <- normalizeOdds(c(home_win, away_win))[1] home_ot <- 0.345 * homenorm + 0.315 @@ -190,9 +190,9 @@ extraTimeSolver <- function(home_win, away_win, draw) { return(c(home_win, home_draw, away_draw, away_win)) } - v_ets <- Vectorize(ets, ) + v_ets <- Vectorize(.ets, ) if (length(home_win) == 1) { - return(ets(home_win = home_win, away_win = away_win, draw = draw)) + return(.ets(home_win = home_win, away_win = away_win, draw = draw)) } else { return(t(v_ets(home_win, away_win, draw))) } @@ -207,7 +207,7 @@ extraTimeSolver <- function(home_win, away_win, draw) { #' @param schedule the schedule to reconfigure #' #' @return a schedule with postponed games moved to the end of the schedule - helps to not drop games that are otherwise in the past but weren't played. -add_postponed_to_schedule_end <- function(schedule = HockeyModel::schedule) { +.add_postponed_to_schedule_end <- function(schedule = HockeyModel::schedule) { if (!any(schedule$GameStatus == "Postponed")) { # no postponed games return(schedule) diff --git a/man/DC_NU_NHL.Rd b/man/DC_NU_NHL.Rd index 298c5994..104aff2e 100644 --- a/man/DC_NU_NHL.Rd +++ b/man/DC_NU_NHL.Rd @@ -9,6 +9,6 @@ DC_NU_NHL \description{ \code{nu = 0} disables cross-season discounting for NHL (seasons are relatively stable year-to-year). Increase to down-weight older seasons more -aggressively. Tune with \code{\link[=tune_dc_weight]{tune_dc_weight()}}. +aggressively. Tune with \code{\link[=.tune_dc_weight]{.tune_dc_weight()}}. } \keyword{internal} diff --git a/man/DC_NU_PWHL.Rd b/man/DC_NU_PWHL.Rd index fe59ea5d..3a7b69b6 100644 --- a/man/DC_NU_PWHL.Rd +++ b/man/DC_NU_PWHL.Rd @@ -9,6 +9,6 @@ DC_NU_PWHL \description{ \code{nu = 2} provides moderate cross-season discounting for PWHL, reflecting the high year-to-year roster volatility from expansion drafts. Tune with -\code{tune_dc_weight(league = "PWHL")}. +\code{.tune_dc_weight(league = "PWHL")}. } \keyword{internal} diff --git a/man/DCPredictErrorRecover.Rd b/man/dot-DCPredictErrorRecover.Rd similarity index 81% rename from man/DCPredictErrorRecover.Rd rename to man/dot-DCPredictErrorRecover.Rd index bc7e6ebd..5c6d58ad 100644 --- a/man/DCPredictErrorRecover.Rd +++ b/man/dot-DCPredictErrorRecover.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/nhl-dixon-coles-predict.R -\name{DCPredictErrorRecover} -\alias{DCPredictErrorRecover} +\name{.DCPredictErrorRecover} +\alias{.DCPredictErrorRecover} \title{Recover fallback expected goals when model prediction fails} \usage{ -DCPredictErrorRecover(team, opponent, homeiceadv = FALSE, m = HockeyModel::m) +.DCPredictErrorRecover(team, opponent, homeiceadv = FALSE, m = HockeyModel::m) } \arguments{ \item{team}{(\code{character(1)}) Team being predicted.} diff --git a/man/DCRhoLogLik.Rd b/man/dot-DCRhoLogLik.Rd similarity index 86% rename from man/DCRhoLogLik.Rd rename to man/dot-DCRhoLogLik.Rd index f9de6de3..8b698805 100644 --- a/man/DCRhoLogLik.Rd +++ b/man/dot-DCRhoLogLik.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/nhl-dixon-coles-fit.R -\name{DCRhoLogLik} -\alias{DCRhoLogLik} +\name{.DCRhoLogLik} +\alias{.DCRhoLogLik} \title{Evaluate Dixon-Coles log-likelihood for a rho value} \usage{ -DCRhoLogLik(y1, y2, lambda, mu, rho = 0, weights = NULL) +.DCRhoLogLik(y1, y2, lambda, mu, rho = 0, weights = NULL) } \arguments{ \item{y1}{(\code{integer}) Home goals.} diff --git a/man/DCweights.Rd b/man/dot-DCweights.Rd similarity index 94% rename from man/DCweights.Rd rename to man/dot-DCweights.Rd index 36c13b04..a88f11c7 100644 --- a/man/DCweights.Rd +++ b/man/dot-DCweights.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/nhl-dixon-coles-fit.R -\name{DCweights} -\alias{DCweights} +\name{.DCweights} +\alias{.DCweights} \title{Compute sigmoid time-decay weights for historical matches} \usage{ -DCweights( +.DCweights( dates, currentDate = Sys.Date(), xi = DC_XI_NHL, @@ -30,7 +30,7 @@ leagues with high year-to-year roster volatility (e.g. PWHL).} \item{season_start_dates}{(\code{Date} or \code{NULL}) A sorted vector of season start dates used to determine which season each game belongs to. Required when \code{nu != 0}; if \code{NULL} and \code{nu != 0} an error is raised. Obtain from -\code{\link[=derive_season_starts]{derive_season_starts()}}.} +\code{\link[=.derive_season_starts]{.derive_season_starts()}}.} } \value{ (\code{double}) Weight per input date in \verb{[0, 1]}. diff --git a/man/add_postponed_to_schedule_end.Rd b/man/dot-add_postponed_to_schedule_end.Rd similarity index 82% rename from man/add_postponed_to_schedule_end.Rd rename to man/dot-add_postponed_to_schedule_end.Rd index 7110dea1..b51d2eae 100644 --- a/man/add_postponed_to_schedule_end.Rd +++ b/man/dot-add_postponed_to_schedule_end.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/validation-helpers.R -\name{add_postponed_to_schedule_end} -\alias{add_postponed_to_schedule_end} +\name{.add_postponed_to_schedule_end} +\alias{.add_postponed_to_schedule_end} \title{Add Postponed Games to Schedule End} \usage{ -add_postponed_to_schedule_end(schedule = HockeyModel::schedule) +.add_postponed_to_schedule_end(schedule = HockeyModel::schedule) } \arguments{ \item{schedule}{the schedule to reconfigure} diff --git a/man/buildPWHLTeamColours.Rd b/man/dot-buildPWHLTeamColours.Rd similarity index 81% rename from man/buildPWHLTeamColours.Rd rename to man/dot-buildPWHLTeamColours.Rd index 07f1c964..3588fa7a 100644 --- a/man/buildPWHLTeamColours.Rd +++ b/man/dot-buildPWHLTeamColours.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/pwhl-api-fetch.R -\name{buildPWHLTeamColours} -\alias{buildPWHLTeamColours} +\name{.buildPWHLTeamColours} +\alias{.buildPWHLTeamColours} \title{Rebuild \code{pwhlTeamColours} package data from source CSV} \usage{ -buildPWHLTeamColours() +.buildPWHLTeamColours() } \value{ \code{NULL} (invisibly). Writes updated data when \code{usethis} is diff --git a/man/buildTeamColours.Rd b/man/dot-buildTeamColours.Rd similarity index 82% rename from man/buildTeamColours.Rd rename to man/dot-buildTeamColours.Rd index 4e545267..83427f05 100644 --- a/man/buildTeamColours.Rd +++ b/man/dot-buildTeamColours.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/data.R -\name{buildTeamColours} -\alias{buildTeamColours} +\name{.buildTeamColours} +\alias{.buildTeamColours} \title{Rebuild \code{teamColours} package data from source CSV} \usage{ -buildTeamColours() +.buildTeamColours() } \value{ \code{NULL} (invisibly). Writes updated data when \code{usethis} is diff --git a/man/build_past_predictions.Rd b/man/dot-build_past_predictions.Rd similarity index 91% rename from man/build_past_predictions.Rd rename to man/dot-build_past_predictions.Rd index 2014ba63..0423ffad 100644 --- a/man/build_past_predictions.Rd +++ b/man/dot-build_past_predictions.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/nhl-league-predictions-log.R -\name{build_past_predictions} -\alias{build_past_predictions} +\name{.build_past_predictions} +\alias{.build_past_predictions} \title{Backfill historical daily prediction records} \usage{ -build_past_predictions( +.build_past_predictions( startDate, endDate, scores = HockeyModel::scores, diff --git a/man/cleanModel.Rd b/man/dot-cleanModel.Rd similarity index 83% rename from man/cleanModel.Rd rename to man/dot-cleanModel.Rd index d54107c7..f0a61ee5 100644 --- a/man/cleanModel.Rd +++ b/man/dot-cleanModel.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/validation-helpers.R -\name{cleanModel} -\alias{cleanModel} +\name{.cleanModel} +\alias{.cleanModel} \title{Clean a model} \usage{ -cleanModel(cm) +.cleanModel(cm) } \arguments{ \item{cm}{model to clean} diff --git a/man/clean_names.Rd b/man/dot-clean_names.Rd similarity index 88% rename from man/clean_names.Rd rename to man/dot-clean_names.Rd index 9be1cd04..9bcaa0a0 100644 --- a/man/clean_names.Rd +++ b/man/dot-clean_names.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/nhl-api-fetch.R -\name{clean_names} -\alias{clean_names} +\name{.clean_names} +\alias{.clean_names} \title{Normalize team name fields} \usage{ -clean_names(sc) +.clean_names(sc) } \arguments{ \item{sc}{(\code{vector} or \code{data.frame}) Values containing team names, or a data diff --git a/man/dot-daily_summary_nhl.Rd b/man/dot-daily_summary_nhl.Rd index 49fb0c39..b5c81662 100644 --- a/man/dot-daily_summary_nhl.Rd +++ b/man/dot-daily_summary_nhl.Rd @@ -15,7 +15,7 @@ \item{subdir}{subdirectory to \code{graphic_dir} for pace plots} -\item{delay}{delay between tweet posts} +\item{delay}{delay between .tweet posts} } \value{ (\code{data.frame}) A combined summary of every attempted social post diff --git a/man/dcExpandedOdds.Rd b/man/dot-dcExpandedOdds.Rd similarity index 85% rename from man/dcExpandedOdds.Rd rename to man/dot-dcExpandedOdds.Rd index 79dea4ca..92965a4a 100644 --- a/man/dcExpandedOdds.Rd +++ b/man/dot-dcExpandedOdds.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/nhl-dixon-coles-predict.R -\name{dcExpandedOdds} -\alias{dcExpandedOdds} +\name{.dcExpandedOdds} +\alias{.dcExpandedOdds} \title{Expand DC odds into regulation/OT/SO result components} \usage{ -dcExpandedOdds(lambda, mu, params = NULL, maxgoal = 8) +.dcExpandedOdds(lambda, mu, params = NULL, maxgoal = 8) } \arguments{ \item{lambda}{(\code{double}) Home expected goals.} diff --git a/man/dcLambda.Rd b/man/dot-dcLambda.Rd similarity index 87% rename from man/dcLambda.Rd rename to man/dot-dcLambda.Rd index b55806d2..b6da847f 100644 --- a/man/dcLambda.Rd +++ b/man/dot-dcLambda.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/nhl-dixon-coles-predict.R -\name{dcLambda} -\alias{dcLambda} +\name{.dcLambda} +\alias{.dcLambda} \title{DC Expected Goals} \usage{ -dcLambda(home, away, params = NULL) +.dcLambda(home, away, params = NULL) } \arguments{ \item{home}{The home team name} diff --git a/man/dcPredictVectorized.Rd b/man/dot-dcPredictVectorized.Rd similarity index 89% rename from man/dcPredictVectorized.Rd rename to man/dot-dcPredictVectorized.Rd index e2ae0d9d..96a67dfd 100644 --- a/man/dcPredictVectorized.Rd +++ b/man/dot-dcPredictVectorized.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/nhl-dixon-coles-predict.R -\name{dcPredictVectorized} -\alias{dcPredictVectorized} +\name{.dcPredictVectorized} +\alias{.dcPredictVectorized} \title{Vectorized Dixon-Coles odds} \usage{ -dcPredictVectorized( +.dcPredictVectorized( home, away, params = NULL, @@ -39,6 +39,6 @@ probability distributed proportionally.} Computes home/draw/away win probabilities for many games at once. The output is statistically identical to calling \link{DCPredict} per game, but avoids the per-game function-call overhead that makes -\code{todayDC()} / \code{remainderSeasonDC()} O(F) in function calls. +\code{.todayDC()} / \code{remainderSeasonDC()} O(F) in function calls. } \keyword{internal} diff --git a/man/dcProbArray.Rd b/man/dot-dcProbArray.Rd similarity index 84% rename from man/dcProbArray.Rd rename to man/dot-dcProbArray.Rd index 266d0056..3127491c 100644 --- a/man/dcProbArray.Rd +++ b/man/dot-dcProbArray.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/nhl-dixon-coles-predict.R -\name{dcProbArray} -\alias{dcProbArray} +\name{.dcProbArray} +\alias{.dcProbArray} \title{Vectorized Dixon-Coles probability array} \usage{ -dcProbArray(lambda, mu, params, maxgoal) +.dcProbArray(lambda, mu, params, maxgoal) } \arguments{ \item{lambda}{(\code{double(n)}) Home expected goals, one value per game.} @@ -22,7 +22,7 @@ dcProbArray(lambda, mu, params, maxgoal) Builds the Dixon-Coles probability matrix for each of many (lambda, mu) pairs at once, returning a 3D array of dimension \verb{(maxgoal+1) x (maxgoal+1) x n}. Each slice \code{pm[,,j]} is exactly what -\link{prob_matrix} returns for the j-th game, so the per-game output is +\link{.prob_matrix} returns for the j-th game, so the per-game output is statistically identical to the scalar path. } \keyword{internal} diff --git a/man/dcProbMatrix.Rd b/man/dot-dcProbMatrix.Rd similarity index 94% rename from man/dcProbMatrix.Rd rename to man/dot-dcProbMatrix.Rd index 84a1151a..18721212 100644 --- a/man/dcProbMatrix.Rd +++ b/man/dot-dcProbMatrix.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/nhl-dixon-coles-predict.R -\name{dcProbMatrix} -\alias{dcProbMatrix} +\name{.dcProbMatrix} +\alias{.dcProbMatrix} \title{Generate the Dixon-Coles' Probability Matrix} \usage{ -dcProbMatrix( +.dcProbMatrix( home, away, params = NULL, diff --git a/man/dcResult.Rd b/man/dot-dcResult.Rd similarity index 85% rename from man/dcResult.Rd rename to man/dot-dcResult.Rd index ea9431ac..f3bbb6bd 100644 --- a/man/dcResult.Rd +++ b/man/dot-dcResult.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/nhl-dixon-coles-predict.R -\name{dcResult} -\alias{dcResult} +\name{.dcResult} +\alias{.dcResult} \title{DC Result Sample} \usage{ -dcResult(lambda, mu, params = NULL, maxgoal = 8, nsim = 1) +.dcResult(lambda, mu, params = NULL, maxgoal = 8, nsim = 1) } \arguments{ \item{lambda}{home team lambda} diff --git a/man/dcxG.Rd b/man/dot-dcxG.Rd similarity index 88% rename from man/dcxG.Rd rename to man/dot-dcxG.Rd index 5b17353b..114328a3 100644 --- a/man/dcxG.Rd +++ b/man/dot-dcxG.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/nhl-dixon-coles-predict.R -\name{dcxG} -\alias{dcxG} +\name{.dcxG} +\alias{.dcxG} \title{Compute expected goals from a Dixon-Coles probability matrix} \usage{ -dcxG(home, away, params = NULL, maxgoal = 10) +.dcxG(home, away, params = NULL, maxgoal = 10) } \arguments{ \item{home}{(\code{character(1)}) Home team name.} diff --git a/man/derive_season_starts.Rd b/man/dot-derive_season_starts.Rd similarity index 89% rename from man/derive_season_starts.Rd rename to man/dot-derive_season_starts.Rd index eb4716fa..45b0c9b1 100644 --- a/man/derive_season_starts.Rd +++ b/man/dot-derive_season_starts.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/nhl-dixon-coles-fit.R -\name{derive_season_starts} -\alias{derive_season_starts} +\name{.derive_season_starts} +\alias{.derive_season_starts} \title{Derive season start dates from a vector of game dates} \usage{ -derive_season_starts(dates, season_month_cutoff = 8L) +.derive_season_starts(dates, season_month_cutoff = 8L) } \arguments{ \item{dates}{(\code{Date}) Vector of game dates.} diff --git a/man/extraTimeSolver.Rd b/man/dot-extraTimeSolver.Rd similarity index 86% rename from man/extraTimeSolver.Rd rename to man/dot-extraTimeSolver.Rd index 2c5dfe9f..3fc071e6 100644 --- a/man/extraTimeSolver.Rd +++ b/man/dot-extraTimeSolver.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/validation-helpers.R -\name{extraTimeSolver} -\alias{extraTimeSolver} +\name{.extraTimeSolver} +\alias{.extraTimeSolver} \title{Split draw probability into overtime/shootout outcomes} \usage{ -extraTimeSolver(home_win, away_win, draw) +.extraTimeSolver(home_win, away_win, draw) } \arguments{ \item{home_win}{(\code{double}) Regulation home-win probabilities.} diff --git a/man/formatPredsForHockeyVisContest.Rd b/man/dot-formatPredsForHockeyVisContest.Rd similarity index 86% rename from man/formatPredsForHockeyVisContest.Rd rename to man/dot-formatPredsForHockeyVisContest.Rd index 9529ef1e..970b5b39 100644 --- a/man/formatPredsForHockeyVisContest.Rd +++ b/man/dot-formatPredsForHockeyVisContest.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/utils-export.R -\name{formatPredsForHockeyVisContest} -\alias{formatPredsForHockeyVisContest} +\name{.formatPredsForHockeyVisContest} +\alias{.formatPredsForHockeyVisContest} \title{Format predictions for the HockeyViz contest submission string} \usage{ -formatPredsForHockeyVisContest( +.formatPredsForHockeyVisContest( predictions, candyType = "Fuzzy Peaches", handle = "@bot.bulsink.ca" diff --git a/man/getAllHomeAwayOdds.Rd b/man/dot-getAllHomeAwayOdds.Rd similarity index 82% rename from man/getAllHomeAwayOdds.Rd rename to man/dot-getAllHomeAwayOdds.Rd index 690e17d7..ac4c4830 100644 --- a/man/getAllHomeAwayOdds.Rd +++ b/man/dot-getAllHomeAwayOdds.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/nhl-league-simulation.R -\name{getAllHomeAwayOdds} -\alias{getAllHomeAwayOdds} +\name{.getAllHomeAwayOdds} +\alias{.getAllHomeAwayOdds} \title{Precompute playoff win odds for all home-away team pairings} \usage{ -getAllHomeAwayOdds(teamlist, params = NULL) +.getAllHomeAwayOdds(teamlist, params = NULL) } \arguments{ \item{teamlist}{(\code{character}) Team names to pair.} diff --git a/man/getCompletedSeries.Rd b/man/dot-getCompletedSeries.Rd similarity index 83% rename from man/getCompletedSeries.Rd rename to man/dot-getCompletedSeries.Rd index 0b4fdeab..be3a2cb0 100644 --- a/man/getCompletedSeries.Rd +++ b/man/dot-getCompletedSeries.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/nhl-league-playoffs.R -\name{getCompletedSeries} -\alias{getCompletedSeries} +\name{.getCompletedSeries} +\alias{.getCompletedSeries} \title{Build winner/loser summary for completed playoff series} \usage{ -getCompletedSeries(currentSeries) +.getCompletedSeries(currentSeries) } \arguments{ \item{currentSeries}{(\code{data.frame}) Series table from \code{\link[=getAPISeries]{getAPISeries()}}.} diff --git a/man/getConferences.Rd b/man/dot-getConferences.Rd similarity index 80% rename from man/getConferences.Rd rename to man/dot-getConferences.Rd index 6c51716e..5f168037 100644 --- a/man/getConferences.Rd +++ b/man/dot-getConferences.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/nhl-team-season-lookup.R -\name{getConferences} -\alias{getConferences} +\name{.getConferences} +\alias{.getConferences} \title{Get conference names from the team lookup table} \usage{ -getConferences(teamColours = HockeyModel::teamColours) +.getConferences(teamColours = HockeyModel::teamColours) } \arguments{ \item{teamColours}{(\code{data.frame}) Team metadata table with a \code{Conference} diff --git a/man/getDivisions.Rd b/man/dot-getDivisions.Rd similarity index 80% rename from man/getDivisions.Rd rename to man/dot-getDivisions.Rd index d88caae7..f4607ad7 100644 --- a/man/getDivisions.Rd +++ b/man/dot-getDivisions.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/nhl-team-season-lookup.R -\name{getDivisions} -\alias{getDivisions} +\name{.getDivisions} +\alias{.getDivisions} \title{Get division names from the team lookup table} \usage{ -getDivisions(teamColours = HockeyModel::teamColours) +.getDivisions(teamColours = HockeyModel::teamColours) } \arguments{ \item{teamColours}{(\code{data.frame}) Team metadata table with a \code{Division} diff --git a/man/getLongTeam.Rd b/man/dot-getLongTeam.Rd similarity index 81% rename from man/getLongTeam.Rd rename to man/dot-getLongTeam.Rd index 397e586a..02d49dae 100644 --- a/man/getLongTeam.Rd +++ b/man/dot-getLongTeam.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/nhl-team-season-lookup.R -\name{getLongTeam} -\alias{getLongTeam} +\name{.getLongTeam} +\alias{.getLongTeam} \title{Convert short team codes to long names} \usage{ -getLongTeam(teams, teamColours = HockeyModel::teamColours) +.getLongTeam(teams, teamColours = HockeyModel::teamColours) } \arguments{ \item{teams}{(\code{character}) Team short codes.} diff --git a/man/getNumGames.Rd b/man/dot-getNumGames.Rd similarity index 82% rename from man/getNumGames.Rd rename to man/dot-getNumGames.Rd index 193abf65..63ff68bd 100644 --- a/man/getNumGames.Rd +++ b/man/dot-getNumGames.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/nhl-team-season-lookup.R -\name{getNumGames} -\alias{getNumGames} +\name{.getNumGames} +\alias{.getNumGames} \title{Get the regular-season game count for a season} \usage{ -getNumGames(season = getCurrentSeason8()) +.getNumGames(season = getCurrentSeason8()) } \arguments{ \item{season}{(\code{character(1)}) Season ID in eight-digit format.} diff --git a/man/getShortTeam.Rd b/man/dot-getShortTeam.Rd similarity index 80% rename from man/getShortTeam.Rd rename to man/dot-getShortTeam.Rd index 079ae44c..2fd8b90b 100644 --- a/man/getShortTeam.Rd +++ b/man/dot-getShortTeam.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/nhl-team-season-lookup.R -\name{getShortTeam} -\alias{getShortTeam} +\name{.getShortTeam} +\alias{.getShortTeam} \title{Convert long team names to short codes} \usage{ -getShortTeam(teams, teamColours = HockeyModel::teamColours) +.getShortTeam(teams, teamColours = HockeyModel::teamColours) } \arguments{ \item{teams}{(\code{character}) Long-form team names.} diff --git a/man/getTeamConferences.Rd b/man/dot-getTeamConferences.Rd similarity index 77% rename from man/getTeamConferences.Rd rename to man/dot-getTeamConferences.Rd index ed397414..6549907e 100644 --- a/man/getTeamConferences.Rd +++ b/man/dot-getTeamConferences.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/nhl-team-season-lookup.R -\name{getTeamConferences} -\alias{getTeamConferences} +\name{.getTeamConferences} +\alias{.getTeamConferences} \title{Get conferences for one or more teams} \usage{ -getTeamConferences(teams, teamColours = HockeyModel::teamColours) +.getTeamConferences(teams, teamColours = HockeyModel::teamColours) } \arguments{ \item{teams}{(\code{character}) Team names.} diff --git a/man/getTeamDivisions.Rd b/man/dot-getTeamDivisions.Rd similarity index 78% rename from man/getTeamDivisions.Rd rename to man/dot-getTeamDivisions.Rd index 6e2f59c8..146b2c58 100644 --- a/man/getTeamDivisions.Rd +++ b/man/dot-getTeamDivisions.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/nhl-team-season-lookup.R -\name{getTeamDivisions} -\alias{getTeamDivisions} +\name{.getTeamDivisions} +\alias{.getTeamDivisions} \title{Get divisions for one or more teams} \usage{ -getTeamDivisions(teams, teamColours = HockeyModel::teamColours) +.getTeamDivisions(teams, teamColours = HockeyModel::teamColours) } \arguments{ \item{teams}{(\code{character}) Team names.} diff --git a/man/get_prediction_dates.Rd b/man/dot-get_prediction_dates.Rd similarity index 80% rename from man/get_prediction_dates.Rd rename to man/dot-get_prediction_dates.Rd index a594444c..9a27c0cf 100644 --- a/man/get_prediction_dates.Rd +++ b/man/dot-get_prediction_dates.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/package-setup.R -\name{get_prediction_dates} -\alias{get_prediction_dates} +\name{.get_prediction_dates} +\alias{.get_prediction_dates} \title{List valid prediction file dates} \usage{ -get_prediction_dates(dir = getOption("HockeyModel.prediction.path")) +.get_prediction_dates(dir = getOption("HockeyModel.prediction.path")) } \arguments{ \item{dir}{Directory to search. Defaults to diff --git a/man/historicalPoints.Rd b/man/dot-historicalPoints.Rd similarity index 82% rename from man/historicalPoints.Rd rename to man/dot-historicalPoints.Rd index c11689b6..3ae70e09 100644 --- a/man/historicalPoints.Rd +++ b/man/dot-historicalPoints.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/validation-helpers.R -\name{historicalPoints} -\alias{historicalPoints} +\name{.historicalPoints} +\alias{.historicalPoints} \title{Get Historical Points for all teams listed in a scores frame} \usage{ -historicalPoints(sc) +.historicalPoints(sc) } \arguments{ \item{sc}{scores frame} diff --git a/man/load_or_get_nst.Rd b/man/dot-load_or_get_nst.Rd similarity index 92% rename from man/load_or_get_nst.Rd rename to man/dot-load_or_get_nst.Rd index 5ab9c18a..cef0d548 100644 --- a/man/load_or_get_nst.Rd +++ b/man/dot-load_or_get_nst.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/nhl-api-fetch.R -\name{load_or_get_nst} -\alias{load_or_get_nst} +\name{.load_or_get_nst} +\alias{.load_or_get_nst} \title{Load or download a Natural Stat Trick game report} \usage{ -load_or_get_nst( +.load_or_get_nst( gid, cache_path = getOption("HockeyModel.nst.cache.path", "~/Documents/natstattrick.csv") ) diff --git a/man/nhl_boxscore.Rd b/man/dot-nhl_boxscore.Rd similarity index 85% rename from man/nhl_boxscore.Rd rename to man/dot-nhl_boxscore.Rd index 204f708d..a5e5732e 100644 --- a/man/nhl_boxscore.Rd +++ b/man/dot-nhl_boxscore.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/nhl-api-fetch.R -\name{nhl_boxscore} -\alias{nhl_boxscore} +\name{.nhl_boxscore} +\alias{.nhl_boxscore} \title{Fetch an NHL boxscore payload} \usage{ -nhl_boxscore(gid) +.nhl_boxscore(gid) } \arguments{ \item{gid}{(\code{character(1)} or \code{numeric(1)}) NHL game ID.} diff --git a/man/parseCores.Rd b/man/dot-parseCores.Rd similarity index 86% rename from man/parseCores.Rd rename to man/dot-parseCores.Rd index fed8efd2..0df706ae 100644 --- a/man/parseCores.Rd +++ b/man/dot-parseCores.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/package-setup.R -\name{parseCores} -\alias{parseCores} +\name{.parseCores} +\alias{.parseCores} \title{Resolve a safe worker-core count} \usage{ -parseCores(cores) +.parseCores(cores) } \arguments{ \item{cores}{(\code{integer(1)} or \code{NULL}) Requested core count.} diff --git a/man/parse_pwhl_dc_params.Rd b/man/dot-parse_pwhl_dc_params.Rd similarity index 86% rename from man/parse_pwhl_dc_params.Rd rename to man/dot-parse_pwhl_dc_params.Rd index 8a16819a..8275243b 100644 --- a/man/parse_pwhl_dc_params.Rd +++ b/man/dot-parse_pwhl_dc_params.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/pwhl-model-core.R -\name{parse_pwhl_dc_params} -\alias{parse_pwhl_dc_params} +\name{.parse_pwhl_dc_params} +\alias{.parse_pwhl_dc_params} \title{Parse PWHL Dixon-Coles parameter list} \usage{ -parse_pwhl_dc_params(params = NULL) +.parse_pwhl_dc_params(params = NULL) } \arguments{ \item{params}{(\code{list} or \code{NULL}) Candidate parameters, optionally nested diff --git a/man/prob_matrix.Rd b/man/dot-prob_matrix.Rd similarity index 71% rename from man/prob_matrix.Rd rename to man/dot-prob_matrix.Rd index 412c3189..d578dbf0 100644 --- a/man/prob_matrix.Rd +++ b/man/dot-prob_matrix.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/nhl-dixon-coles-predict.R -\name{prob_matrix} -\alias{prob_matrix} +\name{.prob_matrix} +\alias{.prob_matrix} \title{Probability Matrix} \usage{ -prob_matrix(lambda, mu, params, maxgoal) +.prob_matrix(lambda, mu, params, maxgoal) } \arguments{ \item{lambda}{home lambda} @@ -17,8 +17,8 @@ prob_matrix(lambda, mu, params, maxgoal) } \value{ a square matrix of maxgoal:maxgoal, with all entries in \verb{[0, 1]} and -summing to 1 (see \link{validateProbMatrix}) +summing to 1 (see \link{.validateProbMatrix}) } \description{ -Given a mu, lambda, rho, and theta, generate a probability matrix. Differs from dcProbMatrix in that no regresson or solving for supplied teams happens +Given a mu, lambda, rho, and theta, generate a probability matrix. Differs from .dcProbMatrix in that no regresson or solving for supplied teams happens } diff --git a/man/pwhl_add_result.Rd b/man/dot-pwhl_add_result.Rd similarity index 90% rename from man/pwhl_add_result.Rd rename to man/dot-pwhl_add_result.Rd index 92a40f34..b552e7d1 100644 --- a/man/pwhl_add_result.Rd +++ b/man/dot-pwhl_add_result.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/pwhl-model-core.R -\name{pwhl_add_result} -\alias{pwhl_add_result} +\name{.pwhl_add_result} +\alias{.pwhl_add_result} \title{Add \code{Result} column to PWHL scores} \usage{ -pwhl_add_result(scores) +.pwhl_add_result(scores) } \arguments{ \item{scores}{(\code{data.frame}) PWHL scores as returned by \code{\link[=getPWHLScores]{getPWHLScores()}}.} diff --git a/man/pwhl_api_request.Rd b/man/dot-pwhl_api_request.Rd similarity index 82% rename from man/pwhl_api_request.Rd rename to man/dot-pwhl_api_request.Rd index 40e11fc8..7d4cac3a 100644 --- a/man/pwhl_api_request.Rd +++ b/man/dot-pwhl_api_request.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/pwhl-api-fetch.R -\name{pwhl_api_request} -\alias{pwhl_api_request} +\name{.pwhl_api_request} +\alias{.pwhl_api_request} \title{Build a PWHL HockeyTech API request} \usage{ -pwhl_api_request(params) +.pwhl_api_request(params) } \arguments{ \item{params}{Named list of query parameters to append.} diff --git a/man/pwhl_game_summary.Rd b/man/dot-pwhl_game_summary.Rd similarity index 81% rename from man/pwhl_game_summary.Rd rename to man/dot-pwhl_game_summary.Rd index 11400566..6ee23cfd 100644 --- a/man/pwhl_game_summary.Rd +++ b/man/dot-pwhl_game_summary.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/pwhl-api-fetch.R -\name{pwhl_game_summary} -\alias{pwhl_game_summary} +\name{.pwhl_game_summary} +\alias{.pwhl_game_summary} \title{Fetch a single PWHL game summary} \usage{ -pwhl_game_summary(gid) +.pwhl_game_summary(gid) } \arguments{ \item{gid}{(\code{integer(1)}) PWHL game ID.} diff --git a/man/pwhl_resolve_team_name.Rd b/man/dot-pwhl_resolve_team_name.Rd similarity index 73% rename from man/pwhl_resolve_team_name.Rd rename to man/dot-pwhl_resolve_team_name.Rd index 8e73934f..1c706ab7 100644 --- a/man/pwhl_resolve_team_name.Rd +++ b/man/dot-pwhl_resolve_team_name.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/pwhl-api-fetch.R -\name{pwhl_resolve_team_name} -\alias{pwhl_resolve_team_name} +\name{.pwhl_resolve_team_name} +\alias{.pwhl_resolve_team_name} \title{Resolve a PWHL team name from PWHLID} \usage{ -pwhl_resolve_team_name(pwhlID, pwhlTeamColours = HockeyModel::pwhlTeamColours) +.pwhl_resolve_team_name(pwhlID, pwhlTeamColours = HockeyModel::pwhlTeamColours) } \arguments{ \item{pwhlID}{the numeric pwhlID} diff --git a/man/pwhl_season_start_date.Rd b/man/dot-pwhl_season_start_date.Rd similarity index 74% rename from man/pwhl_season_start_date.Rd rename to man/dot-pwhl_season_start_date.Rd index 87a932f0..1fd3f4fb 100644 --- a/man/pwhl_season_start_date.Rd +++ b/man/dot-pwhl_season_start_date.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/pwhl-model-core.R -\name{pwhl_season_start_date} -\alias{pwhl_season_start_date} +\name{.pwhl_season_start_date} +\alias{.pwhl_season_start_date} \title{PWHL season start date} \usage{ -pwhl_season_start_date(schedule = HockeyModel::pwhlSchedule) +.pwhl_season_start_date(schedule = HockeyModel::pwhlSchedule) } \arguments{ \item{schedule}{(\code{data.frame}) PWHL schedule. Defaults to diff --git a/man/reseedTwoTeams.Rd b/man/dot-reseedTwoTeams.Rd similarity index 84% rename from man/reseedTwoTeams.Rd rename to man/dot-reseedTwoTeams.Rd index e51402d8..168f2c50 100644 --- a/man/reseedTwoTeams.Rd +++ b/man/dot-reseedTwoTeams.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/nhl-league-playoffs.R -\name{reseedTwoTeams} -\alias{reseedTwoTeams} +\name{.reseedTwoTeams} +\alias{.reseedTwoTeams} \title{Order two teams by predicted seeding priority} \usage{ -reseedTwoTeams(team1, team2, summary_results, p1 = NULL) +.reseedTwoTeams(team1, team2, summary_results, p1 = NULL) } \arguments{ \item{team1}{(\code{character(1)}) First team.} diff --git a/man/sampleResult.Rd b/man/dot-sampleResult.Rd similarity index 89% rename from man/sampleResult.Rd rename to man/dot-sampleResult.Rd index db2b337b..8698d09f 100644 --- a/man/sampleResult.Rd +++ b/man/dot-sampleResult.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/nhl-dixon-coles-predict.R -\name{sampleResult} -\alias{sampleResult} +\name{.sampleResult} +\alias{.sampleResult} \title{Sample one or more result labels from expanded win-state probabilities} \usage{ -sampleResult(hw, hot, hso, aso, aot, aw, size = 1) +.sampleResult(hw, hot, hso, aso, aot, aw, size = 1) } \arguments{ \item{hw}{(\code{double}) Regulation home-win probability.} diff --git a/man/seasonValidator.Rd b/man/dot-seasonValidator.Rd similarity index 83% rename from man/seasonValidator.Rd rename to man/dot-seasonValidator.Rd index d7181f33..ece22b19 100644 --- a/man/seasonValidator.Rd +++ b/man/dot-seasonValidator.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/validation-helpers.R -\name{seasonValidator} -\alias{seasonValidator} +\name{.seasonValidator} +\alias{.seasonValidator} \title{Validate an NHL season identifier} \usage{ -seasonValidator(season) +.seasonValidator(season) } \arguments{ \item{season}{(\code{character(1)}) Candidate season ID.} diff --git a/man/sim_batch.Rd b/man/dot-sim_batch.Rd similarity index 92% rename from man/sim_batch.Rd rename to man/dot-sim_batch.Rd index 640ce0a6..ee3eac08 100644 --- a/man/sim_batch.Rd +++ b/man/dot-sim_batch.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/nhl-league-simulation.R -\name{sim_batch} -\alias{sim_batch} +\name{.sim_batch} +\alias{.sim_batch} \title{Build the per-team stats table for a batch of simulations} \usage{ -sim_batch(sim_ids, odds_table, season_sofar = NULL) +.sim_batch(sim_ids, odds_table, season_sofar = NULL) } \arguments{ \item{sim_ids}{(\code{integer}) Simulation numbers to assign to each built table.} diff --git a/man/sim_odds_results.Rd b/man/dot-sim_odds_results.Rd similarity index 91% rename from man/sim_odds_results.Rd rename to man/dot-sim_odds_results.Rd index 1a39455f..59c5c882 100644 --- a/man/sim_odds_results.Rd +++ b/man/dot-sim_odds_results.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/nhl-league-simulation.R -\name{sim_odds_results} -\alias{sim_odds_results} +\name{.sim_odds_results} +\alias{.sim_odds_results} \title{Sample simulated results for odds-table games} \usage{ -sim_odds_results(odds_table) +.sim_odds_results(odds_table) } \arguments{ \item{odds_table}{(\code{data.frame}) Odds table with \code{HomeWin}, \code{HOT}, \code{AOT} diff --git a/man/simulation_chunks.Rd b/man/dot-simulation_chunks.Rd similarity index 88% rename from man/simulation_chunks.Rd rename to man/dot-simulation_chunks.Rd index f39b436e..2d62bb5c 100644 --- a/man/simulation_chunks.Rd +++ b/man/dot-simulation_chunks.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/nhl-league-simulation.R -\name{simulation_chunks} -\alias{simulation_chunks} +\name{.simulation_chunks} +\alias{.simulation_chunks} \title{Split a simulation count into worker chunks} \usage{ -simulation_chunks(nsims, n) +.simulation_chunks(nsims, n) } \arguments{ \item{nsims}{(\code{integer(1)}) Total number of simulations to distribute.} diff --git a/man/single_series_solver.Rd b/man/dot-single_series_solver.Rd similarity index 93% rename from man/single_series_solver.Rd rename to man/dot-single_series_solver.Rd index 40098bf0..74f9b817 100644 --- a/man/single_series_solver.Rd +++ b/man/dot-single_series_solver.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/nhl-league-playoffs.R -\name{single_series_solver} -\alias{single_series_solver} +\name{.single_series_solver} +\alias{.single_series_solver} \title{Given current seriess and a series number and home and away teams, either return true series winner, random series winner (with home/away wins considered) or random series winner} \usage{ -single_series_solver( +.single_series_solver( series_number, currentSeries, homeTeam, diff --git a/man/tau_singular.Rd b/man/dot-tau_singular.Rd similarity index 87% rename from man/tau_singular.Rd rename to man/dot-tau_singular.Rd index 3620354b..cdb8e58f 100644 --- a/man/tau_singular.Rd +++ b/man/dot-tau_singular.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/nhl-dixon-coles-fit.R -\name{tau_singular} -\alias{tau_singular} +\name{.tau_singular} +\alias{.tau_singular} \title{Compute one Dixon-Coles low-score adjustment factor} \usage{ -tau_singular(xx, yy, lambda, mu, rho) +.tau_singular(xx, yy, lambda, mu, rho) } \arguments{ \item{xx}{(\code{integer(1)}) Home goals.} diff --git a/man/todayDC.Rd b/man/dot-todayDC.Rd similarity index 96% rename from man/todayDC.Rd rename to man/dot-todayDC.Rd index dc6247fe..ef35fbb1 100644 --- a/man/todayDC.Rd +++ b/man/dot-todayDC.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/nhl-dixon-coles-workflow.R -\name{todayDC} -\alias{todayDC} +\name{.todayDC} +\alias{.todayDC} \title{DC Predictions Today} \usage{ -todayDC( +.todayDC( params = NULL, today = Sys.Date(), schedule = HockeyModel::schedule, diff --git a/man/tune_dc_weight.Rd b/man/dot-tune_dc_weight.Rd similarity index 87% rename from man/tune_dc_weight.Rd rename to man/dot-tune_dc_weight.Rd index 9d6f7dcb..337790f3 100644 --- a/man/tune_dc_weight.Rd +++ b/man/dot-tune_dc_weight.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/tune_weights.R -\name{tune_dc_weight} -\alias{tune_dc_weight} +\name{.tune_dc_weight} +\alias{.tune_dc_weight} \title{Evaluate a Dixon-Coles weighting configuration} \usage{ -tune_dc_weight(xi = NULL, upsilon = NULL, nu = NULL, league = "NHL") +.tune_dc_weight(xi = NULL, upsilon = NULL, nu = NULL, league = "NHL") } \arguments{ \item{xi}{(\code{double(1)}) Time-decay slope for within-season weighting. @@ -36,7 +36,7 @@ optimiser to find the best weighting parameters. \if{html}{\out{
}}\preformatted{# NHL optim( par = c(DC_XI_NHL, DC_UPSILON_NHL, DC_NU_NHL), - fn = function(p) tune_dc_weight(xi = p[1], upsilon = p[2], nu = p[3]), + fn = function(p) .tune_dc_weight(xi = p[1], upsilon = p[2], nu = p[3]), method = "L-BFGS-B", lower = c(1e-4, 30, 0), upper = c(0.05, 730, 5) @@ -45,7 +45,7 @@ optim( # PWHL optim( par = c(DC_XI_PWHL, DC_UPSILON_PWHL, DC_NU_PWHL), - fn = function(p) tune_dc_weight(p[1], p[2], p[3], league = "PWHL"), + fn = function(p) .tune_dc_weight(p[1], p[2], p[3], league = "PWHL"), method = "L-BFGS-B", lower = c(1e-4, 30, 0), upper = c(0.05, 730, 5), diff --git a/man/tweet.Rd b/man/dot-tweet.Rd similarity index 94% rename from man/tweet.Rd rename to man/dot-tweet.Rd index ede0e50d..b1e9125a 100644 --- a/man/tweet.Rd +++ b/man/dot-tweet.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/frontend-social.R -\name{tweet} -\alias{tweet} +\name{.tweet} +\alias{.tweet} \title{Post daily model graphics to social media} \usage{ -tweet( +.tweet( graphic_dir = .default_nhl_graphics_dir(), delay = stats::runif(1, min = 2, max = 6) * 60 ) diff --git a/man/dot-update_dc_nhl.Rd b/man/dot-update_dc_nhl.Rd index 27a454fb..f612acf5 100644 --- a/man/dot-update_dc_nhl.Rd +++ b/man/dot-update_dc_nhl.Rd @@ -27,7 +27,7 @@ weighting. Defaults to \link{DC_XI_NHL}.} time-decay weighting. Defaults to \link{DC_UPSILON_NHL}.} \item{nu}{(\code{double(1)}) Cross-season discounting exponent. \code{0} (default -\link{DC_NU_NHL}) disables cross-season discounting. See \code{\link[=DCweights]{DCweights()}} for +\link{DC_NU_NHL}) disables cross-season discounting. See \code{\link[=.DCweights]{.DCweights()}} for details.} \item{save_data}{(\code{logical(1)}) If \code{TRUE} and \code{usethis} is installed, writes diff --git a/man/dot-update_dc_pwhl.Rd b/man/dot-update_dc_pwhl.Rd index b02bb430..a33954f6 100644 --- a/man/dot-update_dc_pwhl.Rd +++ b/man/dot-update_dc_pwhl.Rd @@ -28,7 +28,7 @@ time-decay weighting. Defaults to \link{DC_UPSILON_PWHL}.} \item{nu}{(\code{double(1)}) Cross-season discounting exponent. Defaults to \link{DC_NU_PWHL} (2), which provides moderate discounting of older seasons to -account for PWHL expansion-draft roster churn. See \code{\link[=DCweights]{DCweights()}} for +account for PWHL expansion-draft roster churn. See \code{\link[=.DCweights]{.DCweights()}} for details.} \item{save_data}{(\code{logical(1)}) If \code{TRUE} and \code{usethis} is installed, writes diff --git a/man/validateProbMatrix.Rd b/man/dot-validateProbMatrix.Rd similarity index 90% rename from man/validateProbMatrix.Rd rename to man/dot-validateProbMatrix.Rd index 5b22960d..db4399ea 100644 --- a/man/validateProbMatrix.Rd +++ b/man/dot-validateProbMatrix.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/validation-helpers.R -\name{validateProbMatrix} -\alias{validateProbMatrix} +\name{.validateProbMatrix} +\alias{.validateProbMatrix} \title{Validate a Dixon-Coles probability matrix or result-probability vector} \usage{ -validateProbMatrix(x, tol = 1e-06, clamp_tol = 0.001, context = "probability") +.validateProbMatrix(x, tol = 1e-06, clamp_tol = 0.001, context = "probability") } \arguments{ \item{x}{(\code{numeric}) A probability matrix or vector, expected to sum to 1.} diff --git a/man/tweetGames.Rd b/man/tweetGames.Rd index 6ccfa420..17835ea3 100644 --- a/man/tweetGames.Rd +++ b/man/tweetGames.Rd @@ -12,7 +12,7 @@ tweetGames( ) } \arguments{ -\item{games}{Games to tweet graphics from} +\item{games}{Games to .tweet graphics from} \item{delay}{Delay between tweets} diff --git a/tests/testthat/helper-pwhl.R b/tests/testthat/helper-pwhl.R index f01ecea5..30a2ca7b 100644 --- a/tests/testthat/helper-pwhl.R +++ b/tests/testthat/helper-pwhl.R @@ -1,5 +1,5 @@ # Shared PWHL test helpers used across test-pwhl-model-core.R and -# test-nhl-dixon-coles-workflow.R (PWHL todayDC tests) +# test-nhl-dixon-coles-workflow.R (PWHL .todayDC tests) # Minimal sample PWHL scores for offline testing make_pwhl_scores <- function(n_games = 20) { @@ -81,7 +81,7 @@ make_pwhl_schedule <- function(scores) { # Build DC params without running Weibull optimisation (for speed in tests # that don't specifically test .update_dc_pwhl) make_pwhl_params <- function(scores) { - sc <- pwhl_add_result(scores) + sc <- .pwhl_add_result(scores) m <- getM(scores = sc, currentDate = max(sc$Date) + 1) rho <- getRho(m = m, scores = sc) list(m = m, rho = rho, beta = 2.5, eta = 1.5, k = 5.0) diff --git a/tests/testthat/test-frontend-plots.R b/tests/testthat/test-frontend-plots.R index 9109e6bc..57f4e811 100644 --- a/tests/testthat/test-frontend-plots.R +++ b/tests/testthat/test-frontend-plots.R @@ -42,29 +42,23 @@ test_that("plot wrappers route PWHL prediction data through shared graphics (#39 expect_match(dir, "pwhl$") all_predictions }, - plot_prediction_playoffs_by_team = function( - all_predictions, - teamColours, - ... - ) { + plot_prediction_playoffs_by_team = function(all_predictions, + teamColours, + ...) { list(kind = "playoffs", teams = teamColours$Team, data = all_predictions) }, - plot_prediction_presidents_by_team = function( - all_predictions, - teamColours, - ... - ) { + plot_prediction_presidents_by_team = function(all_predictions, + teamColours, + ...) { list( kind = "presidents", teams = teamColours$Team, data = all_predictions ) }, - plot_prediction_points_by_team = function( - all_predictions, - teamColours, - ... - ) { + plot_prediction_points_by_team = function(all_predictions, + teamColours, + ...) { list(kind = "points", teams = teamColours$Team, data = all_predictions) }, .package = "HockeyModel" diff --git a/tests/testthat/test-frontend-social.R b/tests/testthat/test-frontend-social.R index 14586f71..5d506e67 100644 --- a/tests/testthat/test-frontend-social.R +++ b/tests/testthat/test-frontend-social.R @@ -49,7 +49,7 @@ test_that(".summarize_post_results() handles an empty batch without warning (#no expect_named(summary, c("description", "success", "error")) }) -test_that("tweet() reports (not silently swallows) a failed post (#noissue)", { +test_that(".tweet() reports (not silently swallows) a failed post (#noissue)", { withr::local_options(list(HockeyModel.graphics.path = withr::local_tempdir())) local_mocked_bindings( inRegularSeason = function() TRUE, @@ -60,18 +60,18 @@ test_that("tweet() reports (not silently swallows) a failed post (#noissue)", { .package = "atrrr" ) - result <- suppressWarnings(suppressMessages(tweet(delay = 0))) + result <- suppressWarnings(suppressMessages(.tweet(delay = 0))) expect_equal(nrow(result), 3) expect_true(all(!result$success)) expect_true(all(result$error == "rate limited")) }) -test_that("tweet() does nothing outside the regular season (#noissue)", { +test_that(".tweet() does nothing outside the regular season (#noissue)", { local_mocked_bindings( inRegularSeason = function() FALSE, .package = "HockeyModel" ) - result <- tweet(delay = 0) + result <- .tweet(delay = 0) expect_equal(nrow(result), 0) }) diff --git a/tests/testthat/test-graphics-odds.R b/tests/testthat/test-graphics-odds.R index 676de2b9..15957ae6 100644 --- a/tests/testthat/test-graphics-odds.R +++ b/tests/testthat/test-graphics-odds.R @@ -1,6 +1,6 @@ test_that("Today Odds plot OK", { local_mocked_bindings( - todayDC = function(...) { + .todayDC = function(...) { data.frame( Date = as.Date("2019-11-01"), GameID = 2019020196, @@ -24,7 +24,7 @@ test_that("Today Odds plot OK", { expect_identical(p$labels$y, "Result Odds") expect_identical(p$labels$x, "") - if (!requireNamespace('gt')) { + if (!requireNamespace("gt")) { expect_error( suppressWarnings(daily_odds_table(today = as.Date("2019-11-01"))), "Package gt is required" @@ -85,7 +85,7 @@ test_that("todayOddsPlot executes without error", { games_today = function(schedule, date, all_games = FALSE) { schedule[schedule$GameID %in% 2019020196, ] }, - todayDC = function(...) { + .todayDC = function(...) { data.frame( Date = as.Date("2019-11-01"), GameID = 2019020196, diff --git a/tests/testthat/test-graphics-pace.R b/tests/testthat/test-graphics-pace.R index 20cff4c3..9c40c49a 100644 --- a/tests/testthat/test-graphics-pace.R +++ b/tests/testthat/test-graphics-pace.R @@ -19,7 +19,7 @@ test_that("plot_pace_by_team executes without error", { local_mocked_bindings( getSeasonStartDate = function(season = NULL) as.Date("2019-10-01"), - getNumGames = function(season = NULL) 82, + .getNumGames = function(season = NULL) 82, .package = "HockeyModel" ) @@ -53,7 +53,7 @@ test_that("plot_pace_by_division executes without error", { local_mocked_bindings( getSeasonStartDate = function(season = NULL) as.Date("2019-10-01"), - getNumGames = function(season = NULL) 82, + .getNumGames = function(season = NULL) 82, .package = "HockeyModel" ) diff --git a/tests/testthat/test-graphics-plots.R b/tests/testthat/test-graphics-plots.R index d5c9a73b..961afe5a 100644 --- a/tests/testthat/test-graphics-plots.R +++ b/tests/testthat/test-graphics-plots.R @@ -18,7 +18,7 @@ test_that("Single Game xG plot OK", { test_that("Predicted Points plot OK", { preds <- HockeyModel::example_raw_predictions - if (!requireNamespace('ggridges')) { + if (!requireNamespace("ggridges")) { expect_error( suppressWarnings(plot_point_likelihood(preds = preds, savefiles = FALSE)), "Package ggridges is required" diff --git a/tests/testthat/test-graphics-predictions.R b/tests/testthat/test-graphics-predictions.R index a546971d..fdd05d59 100644 --- a/tests/testthat/test-graphics-predictions.R +++ b/tests/testthat/test-graphics-predictions.R @@ -1,6 +1,6 @@ test_that("Points Predictions by Team Graphics Produce", { skip_if_not_installed("ggforce") - if (!requireNamespace('ggforce')) { + if (!requireNamespace("ggforce")) { expect_error( suppressWarnings(plot_prediction_points_by_team( all_predictions = HockeyModel::example_predictions, @@ -50,7 +50,7 @@ test_that("Playoffs Predictions by Team Graphics Produce", { }) test_that("Presidents Predictions by Team Graphics Produce", { - if (!requireNamespace('ggforce')) { + if (!requireNamespace("ggforce")) { expect_error( suppressWarnings(plot_prediction_presidents_by_team( all_predictions = HockeyModel::example_predictions, @@ -88,7 +88,7 @@ test_that("Presidents predictions keep a PWHL facet", { Presidents = c(0.15, 0.2) ) - if (!requireNamespace('ggforce')) { + if (!requireNamespace("ggforce")) { expect_error( suppressWarnings(plot_prediction_presidents_by_team( all_predictions = all_predictions, @@ -114,7 +114,7 @@ test_that("Presidents predictions keep a PWHL facet", { # ============ plot_prediction_playoffs_by_team tests ============ test_that("plot_prediction_playoffs_by_team executes gracefully", { - if (!requireNamespace('ggforce')) { + if (!requireNamespace("ggforce")) { expect_error( plot_prediction_playoffs_by_team(all_predictions = example_predictions), "Package ggforce is required" diff --git a/tests/testthat/test-graphics-tables.R b/tests/testthat/test-graphics-tables.R index 9d54e335..180133e6 100644 --- a/tests/testthat/test-graphics-tables.R +++ b/tests/testthat/test-graphics-tables.R @@ -13,7 +13,7 @@ test_that("Series Odds Table is ok", { HomeWins = c(0, 3, 3), AwayWins = c(4, 3, 2) ) - if (!requireNamespace('gt')) { + if (!requireNamespace("gt")) { expect_error(series_odds_table(series = series), "Package gt is required") skip("No `gt` package.") } @@ -283,7 +283,7 @@ test_that("Playoff Table is ok", { class = "data.frame" ) - if (!requireNamespace('gt')) { + if (!requireNamespace("gt")) { expect_error(format_playoff_odds(po), "Package gt is required") skip("No `gt` package.") } diff --git a/tests/testthat/test-nhl-api-fetch.R b/tests/testthat/test-nhl-api-fetch.R index b529d39a..9b14d6fe 100644 --- a/tests/testthat/test-nhl-api-fetch.R +++ b/tests/testthat/test-nhl-api-fetch.R @@ -66,7 +66,7 @@ test_that("Scores are OK", { test_that("get_xg() uses component parser results", { local_mocked_bindings( - load_or_get_nst = function(gid) { + .load_or_get_nst = function(gid) { data.frame( h_a = c("home", "away"), xgf_all = c(2.5, 1.8), @@ -90,11 +90,11 @@ test_that("get_xg() uses component parser results", { expect_equal(xg$AwayxG[[1]], 1.8) }) -test_that("load_or_get_nst() fetches and caches a Natural Stat Trick report", { +test_that(".load_or_get_nst() fetches and caches a Natural Stat Trick report", { cache_file <- withr::local_tempfile(fileext = ".csv") vcr::use_cassette("nst-report", { - nst <- load_or_get_nst(2020020001, cache_path = cache_file) + nst <- .load_or_get_nst(2020020001, cache_path = cache_file) }) expect_s3_class(nst, "data.frame") @@ -103,7 +103,7 @@ test_that("load_or_get_nst() fetches and caches a Natural Stat Trick report", { # Result should now be served from the cache file, not the network. expect_true(file.exists(cache_file)) - nst_cached <- load_or_get_nst(2020020001, cache_path = cache_file) + nst_cached <- .load_or_get_nst(2020020001, cache_path = cache_file) expect_equal(nst_cached$xgf_all, nst$xgf_all) }) @@ -169,7 +169,7 @@ test_that("getNHLScores derives gameIDs from schedule when gameIDs = NULL (#3.4) local_mocked_bindings( gameIDValidator = function(x) rep(TRUE, length(x)), - nhl_boxscore = function(gid) { + .nhl_boxscore = function(gid) { list( gameState = "OFF", gameDate = "2020-01-01", @@ -201,7 +201,7 @@ test_that("getNHLScores derives gameIDs from schedule when gameIDs = NULL (#3.4) test_that("getNHLScores detects shootout games (#3.7)", { local_mocked_bindings( gameIDValidator = function(x) rep(TRUE, length(x)), - nhl_boxscore = function(gid) { + .nhl_boxscore = function(gid) { list( gameState = "OFF", gameDate = "2020-01-01", @@ -233,7 +233,7 @@ test_that("getNHLScores detects shootout games (#3.7)", { test_that("getNHLScores errors on unrecognized OTStatus values (#3.9)", { local_mocked_bindings( gameIDValidator = function(x) rep(TRUE, length(x)), - nhl_boxscore = function(gid) { + .nhl_boxscore = function(gid) { list( gameState = "OFF", gameDate = "2020-01-01", @@ -268,7 +268,7 @@ test_that("getNHLScores errors on unrecognized OTStatus values (#3.9)", { test_that("getNHLScores rejects tied final scores (#3.10)", { local_mocked_bindings( gameIDValidator = function(x) rep(TRUE, length(x)), - nhl_boxscore = function(gid) { + .nhl_boxscore = function(gid) { list( gameState = "OFF", gameDate = "2020-01-01", @@ -302,7 +302,7 @@ test_that("getNHLScores skips xG lookup when no final scores are retrieved (#3.1 called <- FALSE local_mocked_bindings( gameIDValidator = function(x) rep(TRUE, length(x)), - nhl_boxscore = function(gid) { + .nhl_boxscore = function(gid) { list(gameState = "FUT", gameScheduleState = "OK") }, get_xg = function(gameIds) { diff --git a/tests/testthat/test-nhl-dixon-coles-fit.R b/tests/testthat/test-nhl-dixon-coles-fit.R index 87eb257b..b58a1e75 100644 --- a/tests/testthat/test-nhl-dixon-coles-fit.R +++ b/tests/testthat/test-nhl-dixon-coles-fit.R @@ -17,8 +17,8 @@ test_that("Package weighting constants are numeric and in expected ranges", { expect_gte(DC_NU_PWHL, 0) }) -# ============ derive_season_starts tests ============ -test_that("derive_season_starts returns one date per season", { +# ============ .derive_season_starts tests ============ +test_that(".derive_season_starts returns one date per season", { # Three seasons: 2022-23, 2023-24, 2024-25 dates <- as.Date(c( "2022-10-11", @@ -30,7 +30,7 @@ test_that("derive_season_starts returns one date per season", { "2024-10-08", "2025-01-20" # 2024-25 )) - starts <- derive_season_starts(dates) + starts <- .derive_season_starts(dates) expect_length(starts, 3) expect_s3_class(starts, "Date") expect_true(all(starts == sort(starts))) # sorted @@ -39,29 +39,29 @@ test_that("derive_season_starts returns one date per season", { expect_equal(starts[3], as.Date("2024-10-08")) }) -test_that("derive_season_starts handles a single season", { +test_that(".derive_season_starts handles a single season", { dates <- as.Date(c("2024-10-08", "2024-11-01", "2025-02-15")) - starts <- derive_season_starts(dates) + starts <- .derive_season_starts(dates) expect_length(starts, 1) expect_equal(starts, as.Date("2024-10-08")) }) -# ============ DCweights tests ============ -test_that("DCweights with nu = 0 equals legacy sigmoid weights", { +# ============ .DCweights tests ============ +test_that(".DCweights with nu = 0 equals legacy sigmoid weights", { dates <- as.Date(c("2025-01-01", "2024-06-01", "2023-10-01")) current <- as.Date("2025-03-01") xi <- 0.005 upsilon <- 300L # Compute expected weights using the sigmoid formula directly, without calling - # DCweights(). This guards against regressions in the implementation. + # .DCweights(). This guards against regressions in the implementation. # Formula: w = 1 - 1 / (1 + exp(-xi * (datediffs - upsilon))) # where datediffs = (currentDate - date) in days (positive = past game). datediffs <- as.numeric(as.Date(current) - dates) w_expected <- 1 - 1 / (1 + exp(-xi * (datediffs - upsilon))) w_expected[datediffs <= 0] <- 0 # Future dates get weight 0 - w_new <- DCweights( + w_new <- .DCweights( dates, currentDate = current, xi = xi, @@ -71,21 +71,21 @@ test_that("DCweights with nu = 0 equals legacy sigmoid weights", { expect_equal(w_new, w_expected) }) -test_that("DCweights with nu > 0 reduces weight for older seasons", { +test_that(".DCweights with nu > 0 reduces weight for older seasons", { # Two dates: one in current season, one a full season back season_starts <- as.Date(c("2023-10-01", "2024-10-01")) current <- as.Date("2025-02-01") dates_cur <- as.Date("2024-11-01") # current season dates_prev <- as.Date("2023-11-01") # previous season - w_no_nu <- DCweights( + w_no_nu <- .DCweights( c(dates_cur, dates_prev), currentDate = current, xi = 0.001, upsilon = 365, nu = 0 ) - w_with_nu <- DCweights( + w_with_nu <- .DCweights( c(dates_cur, dates_prev), currentDate = current, xi = 0.001, @@ -100,23 +100,23 @@ test_that("DCweights with nu > 0 reduces weight for older seasons", { expect_equal(w_with_nu[2], w_no_nu[2] * 0.5, tolerance = 1e-10) }) -test_that("DCweights with nu > 0 requires season_start_dates", { +test_that(".DCweights with nu > 0 requires season_start_dates", { dates <- as.Date(c("2024-10-01", "2023-10-01")) expect_error( - DCweights(dates, currentDate = as.Date("2025-01-01"), nu = 2), + .DCweights(dates, currentDate = as.Date("2025-01-01"), nu = 2), "season_start_dates" ) }) -test_that("DCweights assigns zero weight to future dates", { +test_that(".DCweights assigns zero weight to future dates", { dates <- as.Date(c("2025-05-01", "2025-01-01")) current <- as.Date("2025-03-01") - w <- DCweights(dates, currentDate = current, nu = 0) + w <- .DCweights(dates, currentDate = current, nu = 0) expect_equal(w[1], 0) expect_gt(w[2], 0) }) -test_that("DCweights cross-season discount is monotonically decreasing", { +test_that(".DCweights cross-season discount is monotonically decreasing", { season_starts <- as.Date(c( "2021-10-01", "2022-10-01", @@ -131,7 +131,7 @@ test_that("DCweights cross-season discount is monotonically decreasing", { "2022-11-01", "2021-11-01" )) - w <- DCweights( + w <- .DCweights( game_dates, currentDate = current, xi = 0.001, diff --git a/tests/testthat/test-nhl-dixon-coles-predict.R b/tests/testthat/test-nhl-dixon-coles-predict.R index 802d0373..582e7931 100644 --- a/tests/testthat/test-nhl-dixon-coles-predict.R +++ b/tests/testthat/test-nhl-dixon-coles-predict.R @@ -1,10 +1,10 @@ context("test-nhl-dixon-coles-predict") -# ============ dcProbMatrix tests ============ +# ============ .dcProbMatrix tests ============ test_that("DC Functions function", { - pmat <- dcProbMatrix(home = "Toronto Maple Leafs", away = "Ottawa Senators") + pmat <- .dcProbMatrix(home = "Toronto Maple Leafs", away = "Ottawa Senators") expect_equal(sum(pmat), 1) - pmat2 <- prob_matrix( + pmat2 <- .prob_matrix( lambda = 2, mu = 2, params = list("rho" = -0.25, "beta" = 2, "eta" = 2, "k" = 5), @@ -46,8 +46,8 @@ test_that("DC Functions function", { ) }) -test_that("prob_matrix sums to 1", { - pmat <- prob_matrix( +test_that(".prob_matrix sums to 1", { + pmat <- .prob_matrix( lambda = 1.5, mu = 1.5, params = list("rho" = -0.1, "beta" = 2, "eta" = 2, "k" = 3), @@ -56,8 +56,8 @@ test_that("prob_matrix sums to 1", { expect_equal(sum(pmat), 1, tolerance = 1e-10) }) -test_that("dcProbMatrix creates symmetric-like structure", { - pmat <- dcProbMatrix( +test_that(".dcProbMatrix creates symmetric-like structure", { + pmat <- .dcProbMatrix( home = "Toronto Maple Leafs", away = "Toronto Maple Leafs" ) @@ -68,7 +68,7 @@ test_that("dcProbMatrix creates symmetric-like structure", { test_that("DC Convenience functions are ok", { params <- .parse_dc_params(NULL) expect_true( - dcResult(lambda = 3, mu = 3, params = params) %in% + .dcResult(lambda = 3, mu = 3, params = params) %in% c(0, 0.25, 0.4, 0.5, 0.6, 0.75, 1) ) @@ -96,20 +96,20 @@ test_that("dcSample with as_result=FALSE returns data frame", { expect_true(is.character(sim$OTStatus)) }) -test_that("dcResult handles various score combinations", { +test_that(".dcResult handles various score combinations", { set.seed(10) - expect_equal(dcResult(5, 2), 1) - expect_equal(dcResult(2, 5), 0) + expect_equal(.dcResult(5, 2), 1) + expect_equal(.dcResult(2, 5), 0) }) # ============ Regression tests for OT probability fix ============ -test_that("dcResult uses correct away OT probability [2]", { - # dcResult should use otwinnerprob[2] for away OT win (0.75 result) +test_that(".dcResult uses correct away OT probability [2]", { + # .dcResult should use otwinnerprob[2] for away OT win (0.75 result) # Ensure away team can win in OT without using home OT probability set.seed(7441) results <- replicate( 1000, - dcResult( + .dcResult( lambda = 1.5, mu = 1.5, params = list("rho" = -0.1, "beta" = 2, "eta" = 2, "k" = 5), @@ -130,9 +130,9 @@ test_that("dcResult uses correct away OT probability [2]", { ) }) -test_that("dcExpandedOdds uses correct away OT probability [2]", { - # dcExpandedOdds should return 6 probabilities with correct away OT/SO allocations - odds <- dcExpandedOdds( +test_that(".dcExpandedOdds uses correct away OT probability [2]", { + # .dcExpandedOdds should return 6 probabilities with correct away OT/SO allocations + odds <- .dcExpandedOdds( lambda = 1.5, mu = 1.5, params = list("rho" = -0.1, "beta" = 2, "eta" = 2, "k" = 5) @@ -157,10 +157,10 @@ test_that("dcExpandedOdds uses correct away OT probability [2]", { ) }) -test_that("dcResult and dcExpandedOdds use otwinnerprob[2] consistently", { +test_that(".dcResult and .dcExpandedOdds use otwinnerprob[2] consistently", { # Both functions should produce consistent OT/SO probabilities set.seed(9999) - expanded_odds <- dcExpandedOdds( + expanded_odds <- .dcExpandedOdds( lambda = 2.0, mu = 1.0, params = list("rho" = -0.15, "beta" = 2.5, "eta" = 1.5, "k" = 6) @@ -169,7 +169,7 @@ test_that("dcResult and dcExpandedOdds use otwinnerprob[2] consistently", { set.seed(9999) results <- replicate( 5000, - dcResult( + .dcResult( lambda = 2.0, mu = 1.0, params = list("rho" = -0.15, "beta" = 2.5, "eta" = 1.5, "k" = 6), @@ -224,7 +224,7 @@ test_that("getRho maximizes likelihood (not minimizes)", { away.expected <- as.vector(expected[(nrow(scores) + 1):(nrow(scores) * 2)]) weights <- m$data$Weight[seq_len(nrow(scores))] - ll_at_est <- DCRhoLogLik( + ll_at_est <- .DCRhoLogLik( y1 = scores$HomeGoals, y2 = scores$AwayGoals, mu = home.expected, @@ -233,7 +233,7 @@ test_that("getRho maximizes likelihood (not minimizes)", { weights = weights ) - ll_at_minus_0.5 <- suppressWarnings(DCRhoLogLik( + ll_at_minus_0.5 <- suppressWarnings(.DCRhoLogLik( y1 = scores$HomeGoals, y2 = scores$AwayGoals, mu = home.expected, @@ -282,7 +282,7 @@ test_that("DCPredict(draws = FALSE) produces valid and consistent results", { }) # ============ Regression tests for probability validation (Issue 1.2) ============ -test_that("prob_matrix never returns negative probabilities for extreme inputs", { +test_that(".prob_matrix never returns negative probabilities for extreme inputs", { # These parameter combinations previously produced small-to-large negative # probabilities: a large Weibull tie-enhancement (k) can push the diagonal # sum above 1, which used to flip the off-diagonal (win/loss) cells @@ -312,7 +312,7 @@ test_that("prob_matrix never returns negative probabilities for extreme inputs", ) for (tc in extreme_cases) { - pm <- suppressWarnings(prob_matrix( + pm <- suppressWarnings(.prob_matrix( lambda = tc$lambda, mu = tc$mu, params = tc$params, @@ -324,9 +324,9 @@ test_that("prob_matrix never returns negative probabilities for extreme inputs", } }) -test_that("prob_matrix warns when the tie-enhanced diagonal exceeds 1", { +test_that(".prob_matrix warns when the tie-enhanced diagonal exceeds 1", { expect_warning( - prob_matrix( + .prob_matrix( lambda = 1.5, mu = 1.5, params = list(rho = -0.1, beta = 2, eta = 2, k = 50), @@ -336,10 +336,10 @@ test_that("prob_matrix warns when the tie-enhanced diagonal exceeds 1", { ) }) -test_that("dcResult and dcExpandedOdds remain valid for extreme inputs", { +test_that(".dcResult and .dcExpandedOdds remain valid for extreme inputs", { extreme_params <- list(rho = -0.4, beta = 2, eta = 2, k = 10) - odds <- suppressWarnings(dcExpandedOdds( + odds <- suppressWarnings(.dcExpandedOdds( lambda = 8, mu = 8, params = extreme_params, @@ -349,7 +349,7 @@ test_that("dcResult and dcExpandedOdds remain valid for extreme inputs", { expect_equal(sum(odds), 1, tolerance = 1e-8) set.seed(2024) - results <- suppressWarnings(dcResult( + results <- suppressWarnings(.dcResult( lambda = 8, mu = 8, params = extreme_params, @@ -360,7 +360,7 @@ test_that("dcResult and dcExpandedOdds remain valid for extreme inputs", { }) # ============ Regression tests for vectorized odds (Issue 4.8) ============ -test_that("dcPredictVectorized matches DCPredict per-game (draws = TRUE)", { +test_that(".dcPredictVectorized matches DCPredict per-game (draws = TRUE)", { params <- .parse_dc_params(NULL) home <- c( "Toronto Maple Leafs", @@ -374,7 +374,7 @@ test_that("dcPredictVectorized matches DCPredict per-game (draws = TRUE)", { "Philadelphia Flyers", "New Jersey Devils" ) - vec <- dcPredictVectorized( + vec <- .dcPredictVectorized( home = home, away = away, params = params, @@ -397,14 +397,14 @@ test_that("dcPredictVectorized matches DCPredict per-game (draws = TRUE)", { expect_true(all(rowSums(vec) == 1)) }) -test_that("dcPredictVectorized matches DCPredict per-game (draws = FALSE)", { +test_that(".dcPredictVectorized matches DCPredict per-game (draws = FALSE)", { # Locks in the fix for the sequential-assignment bias in DCPredict's # !draws branch: both home and away must use the original (pre-update) # draw probability when redistributing. params <- .parse_dc_params(NULL) home <- c("Toronto Maple Leafs", "New Jersey Devils", "Colorado Avalanche") away <- c("Ottawa Senators", "Philadelphia Flyers", "Dallas Stars") - vec <- dcPredictVectorized( + vec <- .dcPredictVectorized( home = home, away = away, params = params, @@ -427,14 +427,14 @@ test_that("dcPredictVectorized matches DCPredict per-game (draws = FALSE)", { expect_true(all(rowSums(vec) == 1)) }) -test_that("dcPredictVectorized matches DCPredict with regression (expected_mean, season_percent)", { +test_that(".dcPredictVectorized matches DCPredict with regression (expected_mean, season_percent)", { # DCPredict previously dropped expected_mean/season_percent before calling - # dcProbMatrix, so regression was silently ignored. Both paths must now apply + # .dcProbMatrix, so regression was silently ignored. Both paths must now apply # the blend identically. params <- .parse_dc_params(NULL) home <- c("Toronto Maple Leafs", "New Jersey Devils", "Washington Capitals") away <- c("Ottawa Senators", "Philadelphia Flyers", "Buffalo Sabres") - vec <- dcPredictVectorized( + vec <- .dcPredictVectorized( home = home, away = away, params = params, @@ -460,19 +460,19 @@ test_that("dcPredictVectorized matches DCPredict with regression (expected_mean, expect_equal(unname(vec), unname(ref), tolerance = 1e-10) }) -test_that("dcProbArray matches prob_matrix per-game", { +test_that(".dcProbArray matches .prob_matrix per-game", { params <- .parse_dc_params(NULL) lambdas <- c(1.2, 2.8, 3.4, 0.5) mus <- c(2.1, 1.9, 2.7, 3.3) - arr <- dcProbArray(lambda = lambdas, mu = mus, params = params, maxgoal = 10) + arr <- .dcProbArray(lambda = lambdas, mu = mus, params = params, maxgoal = 10) for (j in seq_along(lambdas)) { - ref <- prob_matrix( + ref <- .prob_matrix( lambda = lambdas[j], mu = mus[j], params = params, maxgoal = 10 ) - expect_equal(arr[,, j], ref, tolerance = 1e-12) - expect_equal(sum(arr[,, j]), 1, tolerance = 1e-10) + expect_equal(arr[, , j], ref, tolerance = 1e-12) + expect_equal(sum(arr[, , j]), 1, tolerance = 1e-10) } }) diff --git a/tests/testthat/test-nhl-dixon-coles-workflow.R b/tests/testthat/test-nhl-dixon-coles-workflow.R index f4c019fd..73957f2d 100644 --- a/tests/testthat/test-nhl-dixon-coles-workflow.R +++ b/tests/testthat/test-nhl-dixon-coles-workflow.R @@ -38,7 +38,7 @@ test_that("remainderSeasonDC returns odds table directly", { ] local_mocked_bindings( - todayDC = function(today, schedule, ...) { + .todayDC = function(today, schedule, ...) { day_games <- schedule[schedule$Date == as.Date(today), ] data.frame( HomeTeam = day_games$HomeTeam, @@ -122,7 +122,7 @@ test_that("remainderSeasonDC accumulates every day's games in order", { ) local_mocked_bindings( - todayDC = function(today, schedule, ...) { + .todayDC = function(today, schedule, ...) { day_games <- schedule[schedule$Date == as.Date(today), ] data.frame( HomeTeam = day_games$HomeTeam, @@ -244,12 +244,12 @@ test_that("playoffDC same team near 0.5", { expect_true(abs(result - 0.5) < 0.1) }) -# ============ todayDC tests ============ +# ============ .todayDC tests ============ test_that("DC Today returns data or NULL", { tmpdir <- withr::local_tempdir() withr::local_options("HockeyModel.prediction.path" = tmpdir) - today_odds <- todayDC(today = as.Date("2019-11-01")) + today_odds <- .todayDC(today = as.Date("2019-11-01")) expect_true(is.null(today_odds) || is.data.frame(today_odds)) if (!is.null(today_odds)) { @@ -258,16 +258,16 @@ test_that("DC Today returns data or NULL", { } }) -test_that("todayDC returns NULL for no games", { - result <- todayDC(today = as.Date("2020-07-15")) +test_that(".todayDC returns NULL for no games", { + result <- .todayDC(today = as.Date("2020-07-15")) expect_null(result) }) -test_that("todayDC odds sum to 1 when available", { +test_that(".todayDC odds sum to 1 when available", { sched <- HockeyModel::scores sched <- sched[sched$Date > as.Date("2019-10-01"), ] sched <- sched[sched$Date < as.Date("2019-12-31"), ] - today_odds <- todayDC(today = as.Date("2019-11-01"), schedule = sched) + today_odds <- .todayDC(today = as.Date("2019-11-01"), schedule = sched) if (!is.null(today_odds) && nrow(today_odds) > 0) { for (i in seq_len(nrow(today_odds))) { expect_equal( @@ -279,13 +279,13 @@ test_that("todayDC odds sum to 1 when available", { } }) -# ── todayDC (PWHL) ──────────────────────────────────────────────────────────── +# ── .todayDC (PWHL) ──────────────────────────────────────────────────────────── -test_that("todayDC returns NULL when no PWHL games today", { +test_that(".todayDC returns NULL when no PWHL games today", { scores <- make_pwhl_scores(30) params <- make_pwhl_params(scores) sched <- make_pwhl_schedule(scores) - result <- todayDC( + result <- .todayDC( params = params, today = as.Date("1900-01-01"), schedule = sched, @@ -294,12 +294,12 @@ test_that("todayDC returns NULL when no PWHL games today", { expect_null(result) }) -test_that("todayDC returns correct columns when PWHL games exist", { +test_that(".todayDC returns correct columns when PWHL games exist", { scores <- make_pwhl_scores(30) params <- make_pwhl_params(scores) sched <- make_pwhl_schedule(scores) today <- sched$Date[1] - result <- todayDC( + result <- .todayDC( params = params, today = today, schedule = sched, @@ -314,6 +314,6 @@ test_that("todayDC returns correct columns when PWHL games exist", { expect_true(all(result$AwayWin >= 0 & result$AwayWin <= 1)) }) -test_that("todayDC rejects non-Date today", { - expect_error(todayDC(today = "not-a-date"), class = "rlang_error") +test_that(".todayDC rejects non-Date today", { + expect_error(.todayDC(today = "not-a-date"), class = "rlang_error") }) diff --git a/tests/testthat/test-nhl-league-playoffs.R b/tests/testthat/test-nhl-league-playoffs.R index 434a169b..863d4d27 100644 --- a/tests/testthat/test-nhl-league-playoffs.R +++ b/tests/testthat/test-nhl-league-playoffs.R @@ -33,7 +33,7 @@ test_that("Playoff Sim finishes OK", { expect_equal(sum(playoffResults$Win_Conference), 2) expect_equal(sum(playoffResults$Win_Cup), 1) - if (!requireNamespace('doSNOW')) { + if (!requireNamespace("doSNOW")) { expect_warning( simulatePlayoffs( summary_results = summary_results, diff --git a/tests/testthat/test-nhl-league-predictions-log.R b/tests/testthat/test-nhl-league-predictions-log.R index 5597ace4..fa761d4a 100644 --- a/tests/testthat/test-nhl-league-predictions-log.R +++ b/tests/testthat/test-nhl-league-predictions-log.R @@ -6,7 +6,7 @@ test_that("Predictions File saves", { sched <- HockeyModel::scores sched <- sched[sched$Date > as.Date("2021-01-01"), ] sched <- sched[sched$Date < as.Date("2021-01-31"), ] - expect_true(suppressWarnings(build_past_predictions( + expect_true(suppressWarnings(.build_past_predictions( startDate = "2021-01-29", endDate = "2021-01-30", filepath = tmpfile, diff --git a/tests/testthat/test-nhl-league-simulation.R b/tests/testthat/test-nhl-league-simulation.R index 1ea50a42..4b7edd47 100644 --- a/tests/testthat/test-nhl-league-simulation.R +++ b/tests/testthat/test-nhl-league-simulation.R @@ -26,7 +26,7 @@ test_that("todayOdds returns data frame or NULL", { # ============ todayOdds tests (from test-graphics-comprehensive.R) ============ test_that("todayOdds returns data frame or NULL", { local_mocked_bindings( - todayDC = function(...) { + .todayDC = function(...) { data.frame( Date = as.Date("2019-11-01"), GameID = 2019020196, @@ -45,7 +45,7 @@ test_that("todayOdds returns data frame or NULL", { # ============ simulateSeasonParallel tests ============ test_that("simulateSeasonParallel() sequential branch reuses precomputed HOT/AOT (#52)", { - # The sequential branch historically called extraTimeSolver() twice per + # The sequential branch historically called .extraTimeSolver() twice per # simulation even though odds_table$HOT/AOT are already computed once # before the loop. We assert the branch runs to completion and that its # results match an independent reference computed from the same odds, @@ -147,15 +147,15 @@ test_that("simulateSeasonParallel() parallel branch matches sequential (#49)", { expect_setequal(unique(res$raw_results$SimNo), 1:3) }) -# ============ sim_odds_results tests ============ -test_that("sim_odds_results returns one outcome per game (#45)", { +# ============ .sim_odds_results tests ============ +test_that(".sim_odds_results returns one outcome per game (#45)", { odds_table <- data.frame( HomeWin = c(0.5, 1, 0), HOT = c(0.1, 0, 0), AOT = c(0.05, 0, 0), stringsAsFactors = FALSE ) - res <- sim_odds_results(odds_table) + res <- .sim_odds_results(odds_table) expect_named(res, c("res1", "res2", "Result")) expect_length(res$res1, 3) expect_length(res$res2, 3) @@ -168,20 +168,20 @@ test_that("sim_odds_results returns one outcome per game (#45)", { expect_true(all(res$Result %in% c(1, 0.75, 0.6, 0.4, 0.25, 0))) }) -# ============ simulation_chunks tests ============ -test_that("simulation_chunks distributes exactly nsims (#51)", { +# ============ .simulation_chunks tests ============ +test_that(".simulation_chunks distributes exactly nsims (#51)", { for (nsims in c(1L, 5L, 100L, 1000L)) { for (n in c(1L, 2L, 4L, 7L)) { - sizes <- simulation_chunks(nsims, n) + sizes <- .simulation_chunks(nsims, n) expect_length(sizes, n) expect_equal(sum(sizes), nsims) expect_true(all(sizes >= 0)) } } # Remainder is spread over the first (nsims %% n) chunks. - expect_equal(simulation_chunks(10, 3), c(4, 3, 3)) - expect_equal(simulation_chunks(7, 7), c(1, 1, 1, 1, 1, 1, 1)) - expect_equal(simulation_chunks(4, 4), c(1, 1, 1, 1)) + expect_equal(.simulation_chunks(10, 3), c(4, 3, 3)) + expect_equal(.simulation_chunks(7, 7), c(1, 1, 1, 1, 1, 1, 1)) + expect_equal(.simulation_chunks(4, 4), c(1, 1, 1, 1)) }) # ============ loopless_sim chunk count (#51) ============ diff --git a/tests/testthat/test-nhl-team-season-lookup.R b/tests/testthat/test-nhl-team-season-lookup.R index ba924ec8..dbc8a28c 100644 --- a/tests/testthat/test-nhl-team-season-lookup.R +++ b/tests/testthat/test-nhl-team-season-lookup.R @@ -46,13 +46,13 @@ test_that("getSeasonStartDate returns dates", { }) }) -test_that("getNumGames returns a game count", { +test_that(".getNumGames returns a game count", { vcr::use_cassette("num-games", { - n <- getNumGames(season = "20182019") + n <- .getNumGames(season = "20182019") expect_true(is.numeric(n)) expect_length(n, 1) expect_true(n > 0) }) - expect_error(getNumGames(season = "not-a-season")) + expect_error(.getNumGames(season = "not-a-season")) }) diff --git a/tests/testthat/test-pwhl-api-fetch.R b/tests/testthat/test-pwhl-api-fetch.R index 8d66dcb4..9a66b6ce 100644 --- a/tests/testthat/test-pwhl-api-fetch.R +++ b/tests/testthat/test-pwhl-api-fetch.R @@ -150,20 +150,20 @@ test_that("pwhlSchedule has correct empty structure", { ) }) -test_that("getLongTeam and pwhl_get_short_team works for PWHL", { +test_that(".getLongTeam and pwhl_get_short_team works for PWHL", { tc <- HockeyModel::pwhlTeamColours codes <- tc$ShortCode teams <- tc$Team - long <- getLongTeam(codes, tc) + long <- .getLongTeam(codes, tc) expect_equal(long, teams) - short <- getShortTeam(teams, tc) + short <- .getShortTeam(teams, tc) expect_equal(short, codes) }) test_that("pwhl_get_long_team returns NA for unknown code", { - result <- getLongTeam("XYZ", HockeyModel::pwhlTeamColours) + result <- .getLongTeam("XYZ", HockeyModel::pwhlTeamColours) expect_true(is.na(result)) }) diff --git a/tests/testthat/test-pwhl-daily-summary.R b/tests/testthat/test-pwhl-daily-summary.R index 553179df..668f02c3 100644 --- a/tests/testthat/test-pwhl-daily-summary.R +++ b/tests/testthat/test-pwhl-daily-summary.R @@ -15,7 +15,7 @@ test_that(".daily_summary_pwhl() reports (not silently swallows) failed posts (# params = NULL ) }, - parse_pwhl_dc_params = function(params = NULL) list(m = NULL), + .parse_pwhl_dc_params = function(params = NULL) list(m = NULL), pwhl_games_today = function(schedule, date = Sys.Date()) NULL, getPWHLPlayoffSeries = function() data.frame(), pwhl_in_season = function(schedule) FALSE, @@ -48,7 +48,7 @@ test_that(".daily_summary_pwhl() attributes failed posts to their description (# params = NULL ) }, - parse_pwhl_dc_params = function(params = NULL) list(m = 1), + .parse_pwhl_dc_params = function(params = NULL) list(m = 1), pwhl_games_today = function(schedule, date = Sys.Date()) { data.frame( Date = Sys.Date() + 1, diff --git a/tests/testthat/test-pwhl-model-core.R b/tests/testthat/test-pwhl-model-core.R index a9d1d264..e2b3f6e5 100644 --- a/tests/testthat/test-pwhl-model-core.R +++ b/tests/testthat/test-pwhl-model-core.R @@ -1,46 +1,46 @@ # Tests for PWHL model functions (helpers live in helper-pwhl.R) -# ── pwhl_add_result ─────────────────────────────────────────────────────────── +# ── .pwhl_add_result ─────────────────────────────────────────────────────────── -test_that("pwhl_add_result adds Result column with correct encodings", { +test_that(".pwhl_add_result adds Result column with correct encodings", { scores <- data.frame( HomeGoals = c(3, 3, 3, 1, 1, 2), # regulation, home OT win, home SO win AwayGoals = c(1, 2, 2, 2, 2, 3), # regulation, away OT win, away SO win OTStatus = c("", "OT", "SO", "", "OT", "SO"), stringsAsFactors = FALSE ) - out <- pwhl_add_result(scores) + out <- .pwhl_add_result(scores) expect_true("Result" %in% names(out)) expect_equal(out$Result, c(1, 0.75, 0.6, 0, 0.25, 0.4)) }) -test_that("pwhl_add_result preserves all input columns", { +test_that(".pwhl_add_result preserves all input columns", { scores <- make_pwhl_scores(5) - out <- pwhl_add_result(scores) + out <- .pwhl_add_result(scores) expect_true(all(names(scores) %in% names(out))) expect_equal(nrow(out), nrow(scores)) }) -# ── parse_pwhl_dc_params ────────────────────────────────────────────────────── +# ── .parse_pwhl_dc_params ────────────────────────────────────────────────────── -test_that("parse_pwhl_dc_params falls back to package PWHL params", { - params <- parse_pwhl_dc_params(NULL) +test_that(".parse_pwhl_dc_params falls back to package PWHL params", { + params <- .parse_pwhl_dc_params(NULL) expect_type(params, "list") expect_named(params, c("m", "rho", "beta", "eta", "k")) }) -test_that("parse_pwhl_dc_params uses supplied params", { +test_that(".parse_pwhl_dc_params uses supplied params", { fake <- list(m = "a", rho = -0.1, beta = 2, eta = 1, k = 5) - params <- parse_pwhl_dc_params(fake) + params <- .parse_pwhl_dc_params(fake) expect_equal(params$m, "a") expect_equal(params$rho, -0.1) expect_equal(params$beta, 2) }) -test_that("parse_pwhl_dc_params unwraps nested params", { +test_that(".parse_pwhl_dc_params unwraps nested params", { inner <- list(m = "nested", rho = 0, beta = 1, eta = 1, k = 1) nested <- list(params = inner) - params <- parse_pwhl_dc_params(nested) + params <- .parse_pwhl_dc_params(nested) expect_equal(params$m, "nested") }) diff --git a/tests/testthat/test-utils-export.R b/tests/testthat/test-utils-export.R index bab7bb94..22bb35e9 100644 --- a/tests/testthat/test-utils-export.R +++ b/tests/testthat/test-utils-export.R @@ -4,7 +4,7 @@ test_that("IneffectiveMath HockeyVis Contest output is a string", { preds <- HockeyModel::example_predictions if (!is.null(preds) && nrow(preds) > 0) { preds <- preds[preds$predictionDate == max(preds$predictionDate), ] - im <- formatPredsForHockeyVisContest(predictions = preds) + im <- .formatPredsForHockeyVisContest(predictions = preds) expect_true(is.character(im)) } }) diff --git a/tests/testthat/test-validation-helpers.R b/tests/testthat/test-validation-helpers.R index 51288271..a1e55e8f 100644 --- a/tests/testthat/test-validation-helpers.R +++ b/tests/testthat/test-validation-helpers.R @@ -35,7 +35,7 @@ test_that("Past points function works", { scores$Date > as.Date("2017-11-01") & scores$Date < as.Date("2017-12-01"), ] - p <- HockeyModel:::historicalPoints(sc = sc) + p <- HockeyModel:::.historicalPoints(sc = sc) expect_true(is.data.frame(p)) expect_equal(nrow(p), 31) expect_equal(colnames(p), c("Team", "Points", "Season")) @@ -84,14 +84,14 @@ test_that("gameIDValidator handles edge cases", { }) test_that("Season Validates", { - expect_true(seasonValidator("20202021")) - expect_false(seasonValidator("Bob")) - expect_false(seasonValidator(TRUE)) + expect_true(.seasonValidator("20202021")) + expect_false(.seasonValidator("Bob")) + expect_false(.seasonValidator(TRUE)) }) test_that("Draws Normalize", { expect_equal( - extraTimeSolver(0.45, 0.35, 0.2), + .extraTimeSolver(0.45, 0.35, 0.2), c(0.45, 0.1018125, 0.0981875, 0.35) ) }) diff --git a/vignettes/model-description.Rmd b/vignettes/model-description.Rmd index 2662cac9..a30b2069 100644 --- a/vignettes/model-description.Rmd +++ b/vignettes/model-description.Rmd @@ -12,8 +12,8 @@ vignette: > ```{r setup, include = FALSE} knitr::opts_chunk$set( collapse = TRUE, - message = FALSE, - warning = FALSE, + message = FALSE, + warning = FALSE, error = TRUE, comment = "#>" )