Re: Modeling of NFL game results
- To: mathgroup at smc.vnet.net
- Subject: [mg129251] Re: Modeling of NFL game results
- From: Ray Koopman <koopman at sfu.ca>
- Date: Thu, 27 Dec 2012 05:04: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
I my first reply I wrote
> tie[x,m,n] -> 1/2, always. That effectively ignores ties.
That's wrong. I forgot that win[x,m,n] returns log[p], not p.