Re: Modeling of NFL game results
- To: mathgroup at smc.vnet.net
- Subject: [mg129248] Re: Modeling of NFL game results
- From: Ray Koopman <koopman at sfu.ca>
- Date: Thu, 27 Dec 2012 05:03:27 -0500 (EST)
- Delivered-to: l-mathgroup@mail-archive0.wolfram.com
- Delivered-to: l-mathgroup@wolfram.com
- Delivered-to: mathgroup-newout@smc.vnet.net
- Delivered-to: mathgroup-newsend@smc.vnet.net
- References: <kbbitr$9oc$1@smc.vnet.net>
On Dec 24, 11:00 pm, Scott Hemphill <hemph... at hemphills.net> wrote:
> Dear All,
>
> My son is more interested in NFL football than I am, and we had a recent
> discussion concerning the probabilities of certain teams being seeded in
> the playoffs. I first offered him a solution based on the simplistic
> notion that a good team will win in proportion to its season win
> percentage, but my son objected, because that didn't take into
> consideration how good or bad the opponent was. So I undertook to model
> the win/loss percentages for all of the NFL this year, and I offer the
> results to all of you.
>
> I created a model based only on which teams played which teams, and
> whether the result was a win, loss, or draw. I didn't take into
> consideration the points scored, whether the game was home or away,
> whether there were injuries, etc. Also, each team was modeled as having
> an ability which remained constant over the year.
>
> I decided to rate each team with a single number, such that the
> probability that a team rated "r1" has a probability beating a team
> rated "r2" is given by:
>
> p = CDF[NormalDistribution[], r1-r2];
>
> I then used "FindMaximum" to find the set of ratings that maximizes the
> log-likelihood of the observed win/loss/tie results observed through the
> season. (Mathematica experts: is there a better way of doing this,
> perhaps using a builtin regression tool?)
>
> I only wrote this last week, so I built into it the ability to select
> only a portion of the season's results so see how it would have
> performed historically. As more results entered into the model, its
> predictive power has grown to be pretty good. In the last four weeks,
> it has scored 11-5, 10-6, 12-4 and 12-4 in predicting the winners of
> games. In particular, I have identified 14 games in the last four weeks
> where the betting public seemed to be supporting the "wrong" team, and
> this method predicted the winner in 11 of those games. (I also used the
> model to estimated an expected value on the numbers of wins, and I have
> to admit that it's been lucky the last four weeks.)
>
> So I offer the below code for educational purposes, no warranty implied
> or expressed, your mileage may vary.
>
> ========================================================================
> (* ::Package:: *)
>
> (* I wrote this code and hereby place it in the public domain.
> Scott Hemphill 24 December 2012
> *)
>
> (* Warning: If executed, this package will write a file called
> "matrix.m" which contains a 32x32 matrix containing the probabilities
> for each team beating each of the others, as rounded integer
> percentages. I edit this into a PostScript source which generates a
> pretty table.
> *)
>
> filename="matrix.m";
> prec;
> dataweek=16;
>
> wp[n_] := SetOptions[FindMaximum,WorkingPrecision->n];
>
> wp[2*prec];
>
> If[logit===True,
> win[x_,0,0] := -Log[2];
> win[x_,0,n_] := -Log[1+Exp[-x[[n]]]];
> win[x_,m_,0] := -Log[1+Exp[x[[m]]]];
> win[x_,m_,n_] := -Log[1+Exp[x[[m]]-x[[n]]]],
> win[x_,0,0] := Log[1/2];
> win[x_,0,n_] := Log[(1 + Erf[(x[[n]])/Sqrt[2]])/2];
> win[x_,m_,0] := Log[(1 + Erf[(-x[[m]])/Sqrt[2]])/2];
> win[x_,m_,n_] := Log[(1 + Erf[(x[[n]]-x[[m]])/Sqrt[2]])/2]
> ];
>
> tie[x_,m_,n_] := (win[x,m,n]+win[x,n,m])/2;
>
> Fortyniners = 0;
> Bears = 1;
> Bengals = 2;
> Bills = 3;
> Broncos = 4;
> Browns = 5;
> Buccaneers = 6;
> Cardinals = 7;
> Chargers = 8;
> Chiefs = 9;
> Colts = 10;
> Cowboys = 11;
> Dolphins = 12;
> Eagles = 13;
> Falcons = 14;
> Giants = 15;
> Jaguars = 16;
> Jets = 17;
> Lions = 18;
> Packers = 19;
> Panthers = 20;
> Patriots = 21;
> Raiders = 22;
> Rams = 23;
> Ravens = 24;
> Redskins = 25;
> Saints = 26;
> Seahawks = 27;
> Steelers = 28;
> Texans = 29;
> Titans = 30;
> Vikings = 31;
>
> loglikely[x_List,week_] :=
> If[week >= 1,
> win[x,Cowboys,Giants]+
> win[x,Texans,Dolphins]+
> win[x,Patriots,Titans]+
> win[x,Lions,Rams]+
> win[x,Redskins,Saints]+
> win[x,Eagles,Browns]+
> win[x,Falcons,Chiefs]+
> win[x,Jets,Bills]+
> win[x,Vikings,Jaguars]+
> win[x,Bears,Colts]+
> win[x,Cardinals,Seahawks]+
> win[x,Buccaneers,Panthers]+
> win[x,Fortyniners,Packers]+
> win[x,Broncos,Steelers]+
> win[x,Ravens,Bengals]+
> win[x,Chargers,Raiders],0
> ]+
> If[week >= 2,
> win[x,Packers,Bears]+
> win[x,Giants,Buccaneers]+
> win[x,Dolphins,Raiders]+
> win[x,Texans,Jaguars]+
> win[x,Bengals,Browns]+
> win[x,Bills,Chiefs]+
> win[x,Eagles,Ravens]+
> win[x,Panthers,Saints]+
> win[x,Cardinals,Patriots]+
> win[x,Colts,Vikings]+
> win[x,Rams,Redskins]+
> win[x,Seahawks,Cowboys]+
> win[x,Steelers,Jets]+
> win[x,Chargers,Titans]+
> win[x,Fortyniners,Lions]+
> win[x,Falcons,Broncos],0
> ]+
> If[week >= 3,
> win[x,Giants,Panthers]+
> win[x,Cowboys,Buccaneers]+
> win[x,Jaguars,Colts]+
> win[x,Bills,Browns]+
> win[x,Jets,Dolphins]+
> win[x,Chiefs,Saints]+
> win[x,Bengals,Redskins]+
> win[x,Bears,Rams]+
> win[x,Vikings,Fortyniners]+
> win[x,Titans,Lions]+
> win[x,Falcons,Chargers]+
> win[x,Cardinals,Eagles]+
> win[x,Raiders,Steelers]+
> win[x,Texans,Broncos]+
> win[x,Ravens,Patriots]+
> win[x,Seahawks,Packers],0
> ]+
> If[week >= 4,
> win[x,Ravens,Browns]+
> win[x,Patriots,Bills]+
> win[x,Fortyniners,Jets]+
> win[x,Rams,Seahawks]+
> win[x,Falcons,Panthers]+
> win[x,Vikings,Lions]+
> win[x,Chargers,Chiefs]+
> win[x,Texans,Titans]+
> win[x,Bengals,Jaguars]+
> win[x,Broncos,Raiders]+
> win[x,Cardinals,Dolphins]+
> win[x,Redskins,Buccaneers]+
> win[x,Packers,Saints]+
> win[x,Eagles,Giants]+
> win[x,Bears,Cowboys],0
> ]+
> If[week >= 5,
> win[x,Rams,Cardinals]+
> win[x,Steelers,Eagles]+
> win[x,Colts,Packers]+
> win[x,Giants,Browns]+
> win[x,Falcons,Redskins]+
> win[x,Dolphins,Bengals]+
> win[x,Ravens,Chiefs]+
> win[x,Seahawks,Panthers]+
> win[x,Bears,Jaguars]+
> win[x,Patriots,Broncos]+
> win[x,Fortyniners,Bills]+
> win[x,Vikings,Titans]+
> win[x,Saints,Chargers]+
> win[x,Texans,Jets],0
> ]+
> If[week >= 6,
> win[x,Titans,Steelers]+
> win[x,Buccaneers,Chiefs]+
> win[x,Ravens,Cowboys]+
> win[x,Dolphins,Rams]+
> win[x,Lions,Eagles]+
> win[x,Browns,Bengals]+
> win[x,Jets,Colts]+
> win[x,Falcons,Raiders]+
> win[x,Seahawks,Patriots]+
> win[x,Bills,Cardinals]+
> win[x,Giants,Fortyniners]+
> win[x,Redskins,Vikings]+
> win[x,Packers,Texans]+
> win[x,Broncos,Chargers],0
> ]+
> If[week >= 7,
> win[x,Fortyniners,Seahawks]+
> win[x,Vikings,Cardinals]+
> win[x,Cowboys,Panthers]+
> win[x,Saints,Buccaneers]+
> win[x,Packers,Rams]+
> win[x,Giants,Redskins]+
> win[x,Texans,Ravens]+
> win[x,Titans,Bills]+
> win[x,Colts,Browns]+
> win[x,Patriots,Jets]+
> win[x,Raiders,Jaguars]+
> win[x,Steelers,Bengals]+
> win[x,Bears,Lions],0
> ]+
> If[week >= 8,
> win[x,Buccaneers,Vikings]+
> win[x,Browns,Chargers]+
> win[x,Colts,Titans]+
> win[x,Patriots,Rams]+
> win[x,Falcons,Eagles]+
> win[x,Packers,Jaguars]+
> win[x,Bears,Panthers]+
> win[x,Dolphins,Jets]+
> win[x,Steelers,Redskins]+
> win[x,Lions,Seahawks]+
> win[x,Raiders,Chiefs]+
> win[x,Giants,Cowboys]+
> win[x,Broncos,Saints]+
> win[x,Fortyniners,Cardinals],0
> ]+
> If[week >= 9,
> win[x,Chargers,Chiefs]+
> win[x,Packers,Cardinals]+
> win[x,Lions,Jaguars]+
> win[x,Bears,Titans]+
> win[x,Broncos,Bengals]+
> win[x,Panthers,Redskins]+
> win[x,Ravens,Browns]+
> win[x,Colts,Dolphins]+
> win[x,Texans,Bills]+
> win[x,Seahawks,Vikings]+
> win[x,Buccaneers,Raiders]+
> win[x,Steelers,Giants]+
> win[x,Falcons,Cowboys]+
> win[x,Saints,Eagles],0
> ]+
> If[week >= 10,
> win[x,Colts,Jaguars]+
> win[x,Buccaneers,Chargers]+
> win[x,Broncos,Panthers]+
> win[x,Ravens,Raiders]+
> win[x,Vikings,Lions]+
> win[x,Saints,Falcons]+
> win[x,Bengals,Giants]+
> win[x,Patriots,Bills]+
> win[x,Titans,Dolphins]+
> win[x,Seahawks,Jets]+
> tie[x,Fortyniners,Rams]+
> win[x,Cowboys,Eagles]+
> win[x,Texans,Bears]+
> win[x,Steelers,Chiefs],0
> ]+
> If[week >= 11,
> win[x,Bills,Dolphins]+
> win[x,Packers,Lions]+
> win[x,Falcons,Cardinals]+
> win[x,Buccaneers,Panthers]+
> win[x,Cowboys,Browns]+
> win[x,Redskins,Eagles]+
> win[x,Jets,Rams]+
> win[x,Bengals,Chiefs]+
> win[x,Texans,Jaguars]+
> win[x,Saints,Raiders]+
> win[x,Broncos,Chargers]+
> win[x,Patriots,Colts]+
> win[x,Ravens,Steelers]+
> win[x,Fortyniners,Bears],0
> ]+
> If[week >= 12,
> win[x,Texans,Lions]+
> win[x,Redskins,Cowboys]+
> win[x,Patriots,Jets]+
> win[x,Colts,Bills]+
> win[x,Dolphins,Seahawks]+
> win[x,Falcons,Buccaneers]+
> win[x,Bengals,Raiders]+
> win[x,Browns,Steelers]+
> win[x,Jaguars,Titans]+
> win[x,Broncos,Chiefs]+
> win[x,Bears,Vikings]+
> win[x,Ravens,Chargers]+
> win[x,Fortyniners,Saints]+
> win[x,Rams,Cardinals]+
> win[x,Giants,Packers]+
> win[x,Panthers,Eagles],0
> ]+
> If[week >= 13,
> win[x,Falcons,Saints]+
> win[x,Seahawks,Bears]+
> win[x,Texans,Titans]+
> win[x,Patriots,Dolphins]+
> win[x,Bills,Jaguars]+
> win[x,Colts,Lions]+
> win[x,Chiefs,Panthers]+
> win[x,Packers,Vikings]+
> win[x,Rams,Fortyniners]+
> win[x,Jets,Cardinals]+
> win[x,Broncos,Buccaneers]+
> win[x,Steelers,Ravens]+
> win[x,Bengals,Chargers]+
> win[x,Browns,Raiders]+
> win[x,Cowboys,Eagles]+
> win[x,Redskins,Giants],0
> ]+
> If[week >= 14,
> win[x,Broncos,Raiders]+
> win[x,Redskins,Ravens]+
> win[x,Cowboys,Bengals]+
> win[x,Rams,Bills]+
> win[x,Eagles,Buccaneers]+
> win[x,Panthers,Falcons]+
> win[x,Browns,Chiefs]+
> win[x,Chargers,Steelers]+
> win[x,Colts,Titans]+
> win[x,Jets,Jaguars]+
> win[x,Vikings,Bears]+
> win[x,Fortyniners,Dolphins]+
> win[x,Seahawks,Cardinals]+
> win[x,Giants,Saints]+
> win[x,Packers,Lions]+
> win[x,Patriots,Texans],0
> ]+
> If[week >= 15,
> win[x,Bengals,Eagles]+
> win[x,Packers,Bears]+
> win[x,Texans,Colts]+
> win[x,Broncos,Ravens]+
> win[x,Dolphins,Jaguars]+
> win[x,Redskins,Browns]+
> win[x,Vikings,Rams]+
> win[x,Saints,Buccaneers]+
> win[x,Falcons,Giants]+
> win[x,Seahawks,Bills]+
> win[x,Panthers,Chargers]+
> win[x,Cardinals,Lions]+
> win[x,Raiders,Chiefs]+
> win[x,Cowboys,Steelers]+
> win[x,Fortyniners,Patriots]+
> win[x,Titans,Jets],0
> ]+
> If[week >= 16,
> win[x,Falcons,Lions]+
> win[x,Bengals,Steelers]+
> win[x,Vikings,Texans]+
> win[x,Rams,Buccaneers]+
> win[x,Redskins,Eagles]+
> win[x,Saints,Cowboys]+
> win[x,Chargers,Jets]+
> win[x,Packers,Titans]+
> win[x,Panthers,Raiders]+
> win[x,Dolphins,Bills]+
> win[x,Patriots,Jaguars]+
> win[x,Colts,Chiefs]+
> win[x,Broncos,Browns]+
> win[x,Ravens,Giants]+
> win[x,Bears,Cardinals]+
> win[x,Seahawks,Fortyniners],0
> ];
>
> prob[x_,m_,n_] := Exp[win[x,m,n]];
>
> findratings[dataweek_] := Block[{x,x0},
> x0=Table[N[1*^-16,prec],{31}];
> x0=x/.FindMaximum[loglikely[x,dataweek],{x,x0}][[2]];
> x0
> ];
>
> x0 = findratings[dataweek];
> matrix=Round[100*Table[prob[x0,i,j],{i,0,31},{j,0,31}]];
> DeleteFile[filename];
> Save[filename, matrix];
>
> (* Week 17 Games *)
> (* Jets vs Bills *)
> prob[x0,Jets,Bills]
>
> (* Dolphins vs Patriots *)
> prob[x0,Dolphins,Patriots]
>
> (* Panthers vs Saints *)
> prob[x0,Panthers,Saints]
>
> (* Buccaneers vs Falcons *)
> prob[x0,Buccaneers,Falcons]
>
> (* Packers vs Vikings *)
> prob[x0,Packers,Vikings]
>
> (* Ravens vs Bengals *)
> prob[x0,Ravens,Bengals]
>
> (* Browns vs Steelers *)
> prob[x0,Browns,Steelers]
>
> (* Texans vs Colts *)
> prob[x0,Texans,Colts]
>
> (* Jaguars vs Titans *)
> prob[x0,Jaguars,Titans]
>
> (* Eagles vs Giants *)
> prob[x0,Eagles,Giants]
>
> (* Cowboys vs Redskins *)
> prob[x0,Cowboys,Redskins]
>
> (* Bears vs Lions *)
> prob[x0,Bears,Lions]
>
> (* Raiders vs Chargers *)
> prob[x0,Raiders,Chargers]
>
> (* Chiefs vs Broncos *)
> prob[x0,Chiefs,Broncos]
>
> (* Cardinals vs 49ers *)
> prob[x0,Cardinals,Fortyniners]
>
> (* Rams vs Seahawks *)
> prob[x0,Rams,Seahawks]
> ========================================================================
>
> Scott
> --
> Scott Hemphill hemph... at alumni.caltech.edu
> "This isn't flying. This is falling, with style." -- Buzz Lightyear
1. tie[x,m,n] -> 1/2, always. That effectively ignores ties.
2. If win[x,m,n] is supposed to give the log of the probability
that m beats n then low ratings are better than high ratings,
which is fine if that's what you want.
3. The solution is finite only if every team has won at least
one game and lost at least one game. That doesn't happen until
after week 10. After that the problem is well conditioned and
you shouldn't need to mess with the precision.