obama=Import["http://markets.rasmussenreports.com/graphing/jsp/downloadClosingPrice.jsp?contractId=68256","CSV"];
mccain=Import["http://markets.rasmussenreports.com/graphing/jsp/downloadClosingPrice.jsp?contractId=68255","CSV"];

2008 Presidential Election: Rasmussen Markets

The following analysis comes from the Rasmussen Market  presidential election data.  The futures return $100 if the candidate wins but doesn't use real money.

DateListPlot[{obama[[-180;;,{1,5}]],mccain[[-180;;,{1,5}]]},Joined->True, PlotStyle->{Blue,Red},PlotLabel->"Rasmussen Election Futures\nObama   Blue\nMcCain   Red"]

DateListPlot[{obama[[-180;;,{1,6}]],mccain[[-180;;,{1,6}]]}, Filling->Bottom,FillingStyle->Gray,PlotStyle->{Blue,Red},PlotRange->All,PlotLabel->"Rasmussen Election Futures Volume\nObama   Blue\nMcCain   Red"]

Stable parameters for the 180 day data.

lrd1= Differences[Log[obama[[-180;;,5]]]];
lrr1= Differences[Log[mccain[[-180;;,5]]]];
Needs["StableM`"];
pd1=Quiet[SFit[lrd1]];
pr1=Quiet[SFit[lrr1]];
TableForm[{pd1,pr1},TableHeadings-> {{"Obama Closing", "McCain Closing"},{"α","β","γ","δ"}},TableSpacing-> {1,5}]

Here are some calculations.  They are made 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 McCain probability is calculated from the return from the last price to a price of 50 on November 4, from the McCain closing price data.  The Obama probability is calculated likewise from the Obama data.  Keep in mind that the scaling of stable distributions is linear with respect to the expectation or the δ parameter; since the δ parameter is the mean logarithmic change, this analysis is influenced markedly by the dominant trend in the period selected, as the number of days until the election decreases this effect will diminish.

ScaleS1[n_,s1params_List] := {s1params[[1]],s1params[[2]],n^(1/s1params[[1]])s1params[[3]],n s1params[[4]]};
n=DateDifference[Last[mccain][[1]],{2008,11,4}];
repwin=1-SCDF[Log[50/Last[mccain][[5]]],ScaleS1[n,pr1]];
demwin=1-SCDF[Log[50/Last[obama][[5]]],ScaleS1[n,pd1]];
CellPrint[TextCell["Data scaled by "<>ToString[n]<>" days.  Last data point on "<>DateString[Last[mccain][[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.000847833

Probability of Obama win in November 0.998902

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

pd2=Quiet[SFit[Take[lrd1,-90]]];
pr2=Quiet[SFit[Take[lrr1,-90]]];
TableForm[{pd2,pr2},TableHeadings-> {{"Obama Closing", "McCain Closing"},{"α","β","γ","δ"}},TableSpacing-> {1,5}]

repwin=1-SCDF[Log[50/Last[mccain][[5]]],ScaleS1[n,pr2]];
demwin=1-SCDF[Log[50/Last[obama][[5]]],ScaleS1[n,pd2]];
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.00130974

Probability of Obama win in November 1.

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}]], "../e04/Rasmussen08.nb"], {5, 0}]];
t4 = Graphics[Text[Hyperlink[Framed[Style["Presidential Prediction", {txcolor, Bold, Larger}]], "../e05/PresidentialPrediction.html"], {0, 0}]];
(*t5 = Graphics[Text[Hyperlink[Framed[Style["IEM Market", {txcolor, Bold, Larger}]], "../e01/Election08.html"], {0, -1}]];*)
Show[ t1, t3, t4, ImageSize -> 500]
CellPrint[TextCell["\n\n© Copyright " <> ToString[DateList[][[1]]] <> " mathestate    " <> DateString[DateList[], "DateShort"], "Text"]]

© Copyright 2008 mathestate    Mon 3 Nov 2008