rep04=Uncompress["1:eJylmW1oVmUchx/XmnOuZbZszjlfkFREZB8iRGRYWZku00IkRIaEODHfZi9Y\nGRIREVISZWVZ0ostRCRERCLEpmIvaqaITPF1ziiZllJmRef/O18SruB38zwf\nHpjgxTnnOed/Xfd9hsxZNH3uukKh0FqafU1paV02t+S6v8r++1fLoZ6FQkv8\nU0uP+Cpc97X0vq2//X3omVONJqIEEP1LZ1SN/sJG3ACIixt2T77rFRtRCogn\nuq61XTpoI24ExNdXRsx6baeNKAPEu+/Ex0b0BER2Ld/v3nDaRZQD4u7mzgND\nO+yj6AWIt+55dUHXNRtRAYi3F/Z9ccc3NqI3ID5ePL7iyEcnXUQlIL7/Lj42\n4iZAPP3VB7VjjtuIKkDs//2RM5+stRE3A2LvU3EY9uXsA4hv10/MHnf7KG4B\nxAOnlldvut8+ir6AeK998Oal82zErYCY/+WyN2pK7WekGhCJg+82QOyK81ht\nI/oVfxS3F3931gBiSJzHBRvRv/j7ohYQi2JcrLcRAwBxObuYP91hI+qKvzsH\nAmJJDK3FNqK+KIQUQmb3fxEhyOy+R4Qgs/8ybVv9Sz/bCDK7r2UhyOxPZtNi\nRpWNILN/ujZuDOcZEYLMvrHuscfHnTjhIsjsn1862DSnj30UZPYXNDxtBJn9\n0cxl7YNtBJm9oI+NILOPzO6KKyNsBJn9x+xizhxrI8jsD69ak3WOjSCzfxbx\nO8FGkNl/GNpxdcV8G0FmTzwRMrtfOUKQ2Z+NmbXcRpDZhzeUZ0+ajSCzJ95a\nZPaCPjaCzB5XonqTPS/I7BL7czaCzJ6IILPH2Ju6ykaQ2ROfVDJ74uwksyfe\nF2T2xCd1ECD+XBEj3EFIIRQH/pMqBMWBv7ASguJgSjb2mjttBMVBIoLiwF9k\nCkFx8FDcnFtsBMVBIoLiwE8U/W+KA19FQlAc/NUWz5mNoDiYHs04zUZQHPjz\nQgiKA3/8CkFxUDLq5X5H99kIioPD2YKmodw+EYoDf2oJQXHgF58QFAf/xNKs\nwUYUFwdCFBcHQlAc+AEtBMVB4uWkOEhEUBw833jn7O2TbATFQeL4pTh4sDKe\nEmdtJgTFwaBsWmyrtxEUB/6CWwiKg9bopEYbQXHg74MLQXEwULHlIDT/KQ78\nnUYhKA7WdceZ2AiKgz1homYbQXFwb+xht9kIigN/E1sIigP//YgQFAf+RowQ\nFAf+rSUExcGAMceHla20ERQHib8IxYG/TSgExYG/fSwExUFIeWOdjaA42D4p\nJp+NoDjw3xUJQXEQCqgsOeMiKA7KtbFlIygOYviOr7ARFAc6j1E2guIgX6fa\nCIqDndqs7HQRFAd6q3DhrIugOPgjVnftNoLiIH+tYCMoDvJdV/taUBzkryFt\nBMVBfoN3uQiKA+2M7TjnIigOzsfb6SYbQXGQq8i5Fpq8ZPZ8JeD8qEKQ2WPg\n7J7sPCNCkNn1pr7JmVpCkNkVv5ttBJk9EUFm1/092kaQ2X2PCEFmr7H7Qggy\nu/8aUggy+6+xuTbTRpDZ/UQRgsxeayeKEGR2P+OFILP76SoEmV0mWmPfF2T2\n03r/ZyPI7L5ThSCzH7sau5U2gsxetvLNTAM2gsyeeC3I7OcOxM6tjSCzv646\nsBFk9sQTIbMnTnAye741ZiPI7OfTJEBm93cOhCCzf6iBYSPI7P6CW4j/N7uN\noGW/v7DS5KU48HcahaA4OLov3it0uAiKg5NTo7a6XQTFQf6e3UZQHGhnrPJi\n478Br/t5"];
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]];

2004 Presidential Election

This data set is taken from the Iowa Electronic Markets  for the trading of the winner take all Republican presidential futures for 2004.  The contract was on September 21, 2004, was split into a win with greater or less than 52% of the vote.  The sub contracts were added together to get the expected price for a win.  The Democratic party futures are also traded, but the two sets are complementary and generally add to 1.0.  The market ran twenty-four hours a day as a continuous double auction, the prices in the data set are the last price of the day.

data=rep04[[;;-5]];DateListPlot[data,PlotRange->All,Joined->True, PlotLabel-> "Republican Win Election Futures\nClosing Price\n"<>DateString[First[data][[1]],"DateShort"]<>" - \n"<>DateString[Last[data][[1]],"DateShort"]]

Below is a plot of the daily logarithmic returns.  The data set is small, only 153 returns, but we attempt a stable fit.

lr=Differences[Log[data[[All,2]]]];
DateListPlot[Transpose[{Rest[data][[All,1]],lr}],PlotLabel-> "Log Returns",PlotRange->All]

Needs["Histograms`"];
fit=SFit[lr];
CellPrint[TextCell["Stable Parameters\n"<>ToString[fit],"Text"]];
g1=Histogram[lr,HistogramScale-> 1];
g2=Plot[SPDF[x,fit],{x, Min[lr],Max[lr]}, PlotStyle->{Blue,Thickness[0.005]}];
Show[g1,g2]

Stable Parameters
{1.44694, -0.365812, 0.0111624, -0.00229712}

Although the data set is small, the log - log fit suggests that the stable model may be useful.

Quiet[DisplayLogStableFit[lr,fit]]

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["2008 Election", {txcolor, Bold, Larger}]], "../e01/Election08.html"], {0, 0}]];
t3 = Graphics[Text[Hyperlink[Framed[Style["Download Notebook", {txcolor, Bold, Larger}]], "../e00/Election04.nb"], {5, 0}]];
(*t4 = Graphics[Text[Hyperlink[Framed[Style["Previous", {txcolor, Bold, Larger}]], "../map/Overview.html"], {0, 0.5}]];*)
Show[ t1, t2, t3,(* t4,*) ImageSize -> 500]
CellPrint[TextCell["\n\n© Copyright " <> ToString[DateList[][[1]]] <> " mathestate    " <> DateString[DateList[], "DateShort"], "Text"]]

© Copyright 2007 mathestate    Fri 14 Dec 2007