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.