Modeling of NFL game results
- To: mathgroup at smc.vnet.net
- Subject: [mg129243] Modeling of NFL game results
- From: Scott Hemphill <hemphill at hemphills.net>
- Date: Tue, 25 Dec 2012 02:01:09 -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
- Reply-to: hemphill at alumni.caltech.edu
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 hemphill at alumni.caltech.edu
"This isn't flying. This is falling, with style." -- Buzz Lightyear