(*get latest data from WSJ*)
dem1=Import["http://predictions.wsj.com/graphing/jsp/downloadClosingPrice.jsp?contractId=68264","CSV"];
rep1 = Import["http://predictions.wsj.com/graphing/jsp/downloadClosingPrice.jsp?contractId=68265","CSV"];

header=dem1[[1]];
dem={DateList[#1],#2,#3,#4,#5,#6}&@@@Rest[dem1];
rep={DateList[#1],#2,#3,#4,#5,#6}&@@@Rest[rep1];

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,PerformanceGoal->"Speed"];
lp4= LogLogPlot[1-scdf[x,parm,type],{x,0.0001,-4 Min[data]},PlotStyle->Red,PlotRange->All,PerformanceGoal->"Speed"];
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: WSJ Market

This data set is taken from the Wall Street Journal Political Market for the trading of 2008 presidential election futures.  The futures return $100 for the party that wins the 2008 election.  The prices in trading before the election thus are similar to percent 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, but this market unlike the Iowa Electronic Market does not use real money.

DateListPlot[{dem[[All,{1,5}]],rep[[All,{1,5}]]},PlotStyle->{Blue,Red},PlotRange->All,Joined->True,PlotLabel-> "Presidential Election Futures 2008\nDemocrat -- Blue\nRepublican -- Red"]

DateListPlot[{dem[[All,{1,6}]],rep[[All,{1,6}]]},PlotStyle->{Blue,Red},PlotRange->All,PlotLabel->"Daily Volume"]

dem1=Select[dem,#[[6]]>0&];
rep1=Select[rep,#[[6]]>0&];
Length[rep];
Length[rep1];
lrd1= Differences[Log[dem1[[All,5]]]];
lrr1= Differences[Log[rep1[[All,5]]]];
ListPlot[{lrd1,lrr1},PlotRange->All,PlotStyle->{Blue,Red},PlotLabel ->"Log Returns\nDays with Zero Volume Excluded"]

The stable fits (now taken from the most recent 180 days of data).  In the table the closing prices were used only on days with trading to generate the return series.   The graph shows the fit to the Democratic data.

pd1=Quiet[SFit[Take[lrd1,-180]]];
pr1=Quiet[SFit[Take[lrr1,-180]]];

TableForm[{pd1,pr1},TableHeadings-> {{"Dem Closing", "Rep Closing"},{"α","β","γ","δ"}},TableSpacing-> {1,5}]

Quiet[DisplayLogStableFit[Take[lrd1,-180],pd1]]
(*Quiet[DisplayLogStableFit[Take[lrr1,-180],pr1]]*)

The returns are now beginning to show alpha very similar to financial markets.  The current results are a little different from the Iowa Electronic Market results.  There are some very extreme returns in the early trading.  This market may be less reliable as it does not use real money, but the best traders are rewarded by being listed.

Here are some very preliminary calculations.  They are calculated using 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 much closer to the election.  The numbers may not add to one because they are calculated from different data sets.  The Republican probability is calculated from the return from the last price to a price of 50 on November 4, from the Republican closing price data.  The Democratic probability is calculated likewise from the Democratic data.  Note that currently most of the influence is coming from the delta parameter which is currently negative for the Democratic data and positive for the Republican data.  The WSJ data does not show the strong trend recently as the IEM data.

n=DateDifference[Last[rep][[1]],{2008,11,4}];
repwin=1-SCDF[Log[50/Last[rep][[5]]],ScaleS1[n,pr1]];
demwin=1-SCDF[Log[59/Last[dem][[5]]],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 Republican win in November "<>ToString[repwin],"Text"]];
CellPrint[TextCell["Probability of Democratic win in November "<>ToString[demwin],"Text"]];

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

Probability of Republican win in November 0.00143519

Probability of Democratic win in November 0.999469

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[50/Last[rep][[5]]],ScaleS1[n,pr11]];
demwin=1-SCDF[Log[50/Last[dem][[5]]],ScaleS1[n,pd11]];
CellPrint[TextCell["Probability of Republican win in November "<>ToString[repwin],"Text"]];
CellPrint[TextCell["Probability of Democratic win in November "<>ToString[demwin],"Text"]];

Probability of Republican win in November 0.000450165

Probability of Democratic win in November 0.999924

We will update this file about twice a month.  If you download the Mathematica notebook, the code will get the latest data.

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}]], "../e02/WSJElection08.nb"], {5, 0}]];
t4 = Graphics[Text[Hyperlink[Framed[Style["InTrade Market", {txcolor, Bold, Larger}]], "../e03/InTradeElection08.html"], {0, 0}]];
t5 = Graphics[Text[Hyperlink[Framed[Style["IEM Market", {txcolor, Bold, Larger}]], "../e01/Election08.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    Mon 3 Nov 2008