(*get latest data from IEM*)
n=Ceiling[DateDifference[{2007,1,1},DateList[],"Month"][[1]]];
ym={#1,#2}&@@@(DatePlus[{2007,1,1},{#,"Month"}]&/@Range[0,n-1]);
monfn[num_]:=StringTake[ToString[100+num],-2];
data=Import["http://iemweb.biz.uiowa.edu/pricehistory/PriceHistory_GetData.cfm?Market_ID=149&Month="<>monfn[#[[2]]]<>"&Year="<>ToString[#[[1]]],"Data"]&/@ym;
header=data[[1]][[1]];
data1=Flatten[Rest/@data,1];
data1a=Select[data1,#[[3]]≠0&];
data2={DateList[{#1,{"Month","Day","YearShort"}}],#2,#3,#4,#5,#6,#7,#8}&@@@data1a;
dstr=FromCharacterCode[ToCharacterCode[data2[[1]][[2]]]];
rstr=FromCharacterCode[ToCharacterCode[data2[[2]][[2]]]];
(*First Price is zero*)
dem=Union[Rest[Select[data2,#[[2]]==dstr&]]];
rep=Union[Rest[Select[data2,#[[2]]==rstr&]]];
Needs["StableM`"];
LogReturn[data_]:=Differences[Log[N[data]]];
ScaleS1[n_,s1params_List] := {s1params[[1]],s1params[[2]],n^(1/s1params[[1]])s1params[[3]],n s1params[[4]]};
EmpiricCDFList[data_] := Block[{prob,sel,del},
					
					prob= Table[(i-0.5)/Length[data],{i,Length[data]}];
					Transpose[Join[{Sort[data]},{prob}]]];

Clear[DisplayLogStableFit];
scdf[x_?NumericQ,parm_,type_:1,opts___]:=SCDF[x,parm,type,opts];
DisplayLogStableFit[data_,parm_,type_Integer:1]:=Module[{clist,lt,rt,trt,lp1,lp2,lp3,lp4,lp5,nmn,nstd},
clist=EmpiricCDFList[data];
	lt = Select[clist,#[[1]]<0&];
	rt= Select[clist,#[[1]]>0&];
	trt=Transpose[rt];
lp1=ListLogLogPlot[Abs[lt],PlotStyle->Blue,PlotRange->All];
lp2=ListLogLogPlot[Transpose[{trt[[1]],1- trt[[2]]}],PlotStyle->Red,PlotRange->All];
lp3= LogLogPlot[scdf[-x,parm,type],{x,0.0001,-4 Min[data]},PlotStyle->Blue,PlotRange->All];
lp4= LogLogPlot[1-scdf[x,parm,type],{x,0.0001,-4 Min[data]},PlotStyle->Red,PlotRange->All];
nmn=Mean[data];
nstd=StandardDeviation[data];
lp5= LogLogPlot[1-scdf[x,{2,0,nstd /Sqrt[2],nmn},1],{x,0.0001,4 nstd},PlotStyle->Green,PlotRange->All];
Show[lp1,lp2,lp3,lp4,lp5,PlotLabel->"Log Log Left Tail Blue, Right Red, (Normal Green)",AspectRatio->Automatic,PlotRange->All]];

2008 Presidential Election

This data set is taken from the Iowa Electronic Markets  for the trading of the winner take all 2008 presidential election futures.  The futures return $1.00 for the party that wins the popular vote in the 2008 election.  The prices in trading before the election thus are similar to probabilities for a win.  But they are also traded as prices, with the goal that the participants are presumed to be trading for profit.  They are thus trading not based on their political preferences, but base their trades upon the expected outcome.  The theory is that this sort of market should be more accurate than opinion polls.  The data shown are since January 1, 2007.  We are now using the data to predict the election outcome: jump to results.

DateListPlot[{Rest[dem][[All,{1,8}]],Rest[rep][[All,{1,8}]]},PlotStyle->{Blue,Red},PlotRange->All,Joined->True,PlotLabel-> "Presidential Election Futures 2008\nObama -- Blue\nMcCain -- Red"]

DateListPlot[{Select[dem[[All,{1,3}]],NumericQ[#[[2]]]&],Select[rep[[All,{1,3}]],NumericQ[#[[2]]]&]},PlotStyle->{Blue,Red},FillingStyle->Automatic,Filling->Axis, PlotRange->All,PlotLabel->"Daily Volume"]

dem1=Select[dem,#[[3]]≠0&];
rep1=Select[rep,#[[3]]≠0&];
Length[rep];
Length[rep1];
lrd1= Differences[Log[dem[[All,8]]]];
lrr1= Differences[Log[rep[[All,8]]]];
ListPlot[{Take[lrd1,-180],Take[lrr1,-180]},PlotRange->All,PlotStyle->{Blue,Red},PlotLabel ->"Log Returns",Joined->True]

lrd1a= Differences[Select[Log[dem[[All,7]]],NumericQ]];
lrr1a= Differences[Select[Log[rep[[All,7]]],NumericQ]];
ListPlot[{Take[lrd1a,-180],Take[lrr1a,-180]},PlotRange->All,PlotStyle->{Blue,Red},PlotLabel ->"Log Returns Average Daily Price",Joined->True]

The stable fits (taken from the latest 180 days) now show alpha close to the range seen in financial markets.

pd1=Quiet[SFit[Take[lrd1,-180]]];
pr1=Quiet[SFit[Take[lrr1,-180]]];
pd2=Quiet[SFit[Take[lrd1a,-180]]];
pr2=Quiet[SFit[Take[lrr1a,-180]]];
TableForm[{pd1,pr1,pd2,pr2},TableHeadings-> {{"Dem Closing", "Rep Closing","Dem Average", "Rep Average"},{"α","β","γ","δ"}},TableSpacing-> {1,5}]

CellPrint[TextCell["Fit is shown for the Republican data.","Text"]];
Quiet[DisplayLogStableFit[Take[lrr1,-180],pr1]]

Fit is shown for the Republican data.

Here are some calculations.  The calculations use the assumption that the data are stably distributed with the above calculated parameters.  The distribution of most recent 180 days of logarithmic returns is scaled to a distribution that would account for the sum of returns for all the days remaining until the election.  Since the returns are differences, scaling magnifies the trend in the data and will not be very accurate until we are very close to the election.  The numbers may not add to one because they are calculated from different data sets.  The McCain probability is calculated from the return from the last price to a price of 0.5 on November 4, from the McCain closing price data.  The Obama probability is calculated likewise from the Obama data.

n=DateDifference[Last[rep][[1]],{2008,11,4}];
repwin=1-SCDF[Log[0.5/Last[rep][[8]]],ScaleS1[n,pr1]];
demwin=1-SCDF[Log[0.5/Last[dem][[8]]],ScaleS1[n,pd1]];
CellPrint[TextCell["Data scaled by "<>ToString[n]<>" days.  Last data point on "<>DateString[Last[rep][[1]],"DateShort"]<>".","Text"]];
CellPrint[TextCell["Probability of McCain win in November "<>ToString[repwin],"Text"]];
CellPrint[TextCell["Probability of Obama win in November "<>ToString[demwin],"Text"]];

Data scaled by 1 days.  Last data point on Mon 3 Nov 2008.

Probability of McCain win in November 0.00113203

Probability of Obama win in November 0.999239

Here are similar calculations based on a sample of only the last 90 days.

pd11=Quiet[SFit[Take[lrd1,-90]]];
pr11=Quiet[SFit[Take[lrr1,-90]]];
repwin=1-SCDF[Log[0.5/Last[rep][[8]]],ScaleS1[n,pr11]];
demwin=1-SCDF[Log[0.5/Last[dem][[8]]],ScaleS1[n,pd11]];
CellPrint[TextCell["Probability of McCain win in November "<>ToString[repwin],"Text"]];
CellPrint[TextCell["Probability of Obama win in November "<>ToString[demwin],"Text"]];

Probability of McCain win in November 0.00313155

Probability of Obama win in November 0.999792

We will update this file about twice a month.  We may add different methods for prediction in the future, such as the distribution of the ratio of prices (probabilities).  If you download the Mathematica notebook, the code will get the latest data. 

Another interesting site to look at is Sam Wang's poll meta-analysis at the Princeton Election Consortium.

txcolor=RGBColor[181/255,18/255,27/255];
t1 = Graphics[Text[Hyperlink[Framed[Style["Financial Home", {txcolor, Bold, Larger}]], "../map/Overview.html"], {-5, 0}]];
t2 = Graphics[Text[Hyperlink[Framed[Style["2004 Data", {txcolor, Bold, Larger}]], "../e00/Election04.html"], {0,1}]];
t3 = Graphics[Text[Hyperlink[Framed[Style["Download Notebook", {txcolor, Bold, Larger}]], "../e01/Election08.nb"], {5, 0}]];
t4 = Graphics[Text[Hyperlink[Framed[Style["WSJ Market", {txcolor, Bold, Larger}]], "../e02/WSJElection08.html"], {0, 0}]];
t5 = Graphics[Text[Hyperlink[Framed[Style["InTrade Market", {txcolor, Bold, Larger}]], "../e03/InTradeElection08.html"], {0, -1}]];
Show[ t1, t2, t3, t4,t5, ImageSize -> 500]
CellPrint[TextCell["\n\n© Copyright " <> ToString[DateList[][[1]]] <> " mathestate    " <> DateString[DateList[], "DateShort"], "Text"]]

© Copyright 2008 mathestate    Tue 4 Nov 2008