Stable Stock Analyzer

Initialization procedures below this cell

Needs["StableM7`"];
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}]]];
stablecdf[(x_)?NumericQ,p_,type_]:=SCDF[x,p,type];(*trap to prevent LogLogPlot from symbolic processing*)
ft={0.5,0.1,0.05,0.01,0.005,0.001,0.0001};
lfticks=Transpose[{ft,ft}];
rfticks=Transpose[{ft,1-ft}];
Clear[DisplayLogStableFit];
DisplayLogStableFit[data_,parm_,type_Integer:1]:=Module[{clist,lt,rt,trt,lp1,lp2,lp3,lp4,lp5,nmn,nstd,xlim,xlim0},
clist=EmpiricCDFList[data];
	lt = Select[clist,#[[1]]<0&];
	rt= Select[clist,#[[1]]>0&];
	trt=Transpose[rt];
xlim0=Min[rt,Abs[lt]];
xlim=Max[{-Min[data],Max[data]}];
lp1=ListLogLogPlot[Abs[lt],PlotStyle->Blue,PlotRange->All,Frame->True,FrameTicks->{True,lfticks,None,rfticks},Axes->False];
lp2=ListLogLogPlot[Transpose[{trt[[1]],1- trt[[2]]}],PlotStyle->Red,PlotRange->All,Frame->True];
lp3= LogLogPlot[stablecdf[-x,parm,type],{x,xlim0,xlim},PlotStyle->Blue,PlotRange->All];
lp4= LogLogPlot[1-stablecdf[x,parm,type],{x,xlim0,xlim},PlotStyle->Red,PlotRange->All];
nmn=Mean[data];
nstd=StandardDeviation[data];
lp5= LogLogPlot[1-stablecdf[x,{2,0,nstd /Sqrt[2],nmn},1],{x,xlim0,4  nstd},PlotStyle->Green,PlotRange->All];
Show[lp1,lp2,lp3,lp4,lp5,AspectRatio->Automatic,PlotLabel->"Log Log Stable Distribution\nLeft Tail Blue, Right Red, (Normal Green)",PlotRange->All,FrameLabel->{"Abs[x]","Left Tail",None,"Right Tail"}]];

Enter the stock mutual fund or index symbol and the start date.  The program will collect all the data from the Wolfram webserver between the start date and present.  Change the inputs in the cell below, select all the cells in the notebook, and evaluate.
The calculations use a stationary stable strategy, but one of the graphs collects a picture of stable gamma over the previous month.  Projected probabilities will be dependent on the assumptions about gamma and the calculations of alpha which for a stationary model tend to underestimate the value of alpha--see the graph of the fit at the tails.  If you use the calculations for price projections, you must be wary of the errors introduced by a model that is not a fully accurate representation of market behavior.  The program is designed so that market price behavior may be explored; the outputs are not guaranteed to be accurate.  The user must assume all risk for his own interaction with these data.

symbol="GE";
start={1995,1,1};

Get data from web server

Print[FinancialData[symbol,"StandardName"]];
op=FinancialData[symbol,"Open",start];
hi=FinancialData[symbol,"High",start];
lo=FinancialData[symbol,"Low",start];
cl=FinancialData[symbol,"Close",start];
wk=FinancialData[symbol,"Close",{start,DateList[],"Week"}];
vol=FinancialData[symbol,"Volume",start];

Print["Last closing price  ",Last[cl]]

g1=DateListPlot[cl,Joined->True,PlotRange->All,PlotLabel-> "Closing Price "<>symbol,FrameLabel->{"Year","Price"}]
g2=DateListPlot[{#1,Log[10,#2]}&@@@vol,PlotRange->All,PlotStyle->Red,PlotLabel-> "Log Volume "<>symbol,FrameLabel->{"Year","Log  [ 10 ,  Volume ] "},Filling->Bottom, FillingStyle-> Pink]

lrcl=Transpose[{Rest[Transpose[cl][[1]]],LogReturn[Transpose[cl][[2]]]}];
DateListPlot[Map[{#[[1]],Abs[#[[2]]]}&,lrcl],Joined->True,PlotLabel-> "Volatility "<>symbol,FrameLabel->{"Year","Abs[LogReturn]"},PlotRange->All]

absecf0=Compile[{t,{s,_Real,1}},Abs[Mean[Exp[I t s]]]-1/E];
ABSECF0[t_?NumericQ,s_]:=absecf0[t,s];
QkScale[s_]:= Module[{c0,cc},
c0 =QuartileDeviation[s] ;(*this is best for alpha>1,not a reliable starting point as alpha -> 0*)
(*Absolute value of result is taken in case negative root is found*)
Abs[cc/.FindRoot[ABSECF0[1/cc,s],{cc,c0}]]];DateListPlot[Transpose[{Drop[Transpose[cl][[1]],21],Table[Quiet[QkScale[Take[Transpose[lrcl][[2]],{i,i+20}]]],{i,1,Length[lrcl]-20}]}],Joined->True,PlotLabel-> "21 Day Moving Average Volatility (Stable γ) "<>symbol,FrameLabel->{"Year","Stable γ"},PlotRange->All]

params=SMLFit[LogReturn[#1[[All,2]]],1]&/@{op,hi,lo,cl,wk};
Print["Stable S1 Parameters"]
TableForm[{params[[1]],params[[2]],params[[3]],params[[4]],params[[5]],ScaleS1[5,params[[4]]],ScaleS1[21,params[[4]]]},TableHeadings->{{"Day Open Data","Day High Data","Day Low Data","Day Close Data","Week Close","Scaled Week from Day","Scaled Month from Day"},{"α","β","γ","δ"}}]

Stable fit shown in Log-Log format for close data.

dataset= LogReturn[cl[[All,2]]];
Quiet[DisplayLogStableFit[dataset,params[[4]]]]

Slide mouse over the graph below to calculate the probability at a given price.

grlx[xmin_,xmax_]:=Table[x,{x,Floor[xmin],Floor[xmax]}];
grly[ymin_,ymax_]:=Table[x,{x,0,1,0.1}];
month1=ScaleS1[21,params[[4]]];
lastcl=Last[cl[[All,2]]];
prprob=Plot[SCDFi[Log[x/lastcl ],month1,1],{x,Exp[-5 month1[[3]]] lastcl,Exp[5 month1[[3]]] lastcl},PlotStyle->Thickness[0.005],
PlotLabel-> StringJoin[symbol," One Month Price Probability"],GridLines->{grlx,grly},Frame->True,FrameLabel->{"Price","Cumulative   Probability ",None,None}];
Dynamic[xy=MousePosition["Graphics",""];xx=If[Length[xy]>1,xy[[1]],0];yy=If[xx>0,SCDF[Log[xx/lastcl],month1,1],0];Show[prprob,ListPlot[{{xx,yy}},PlotStyle->{Red,PointSize[0.015]}],PlotLabel-> symbol<>" Last Price: "<>ToString[lastcl]<>"\nOne Month Price Probability\n"<>ToString[month1],Frame->True,Axes->False,FrameLabel->{ "X"<>"\n"<>ToString[{xx,yy}],"Probability"}]]

prb= Table[p,{p,0.05,0.95,0.05}];
ret=Round[(Exp[SQuantile[#,ScaleS1[21,params[[4]]],1]]-1) 1000]/10.&/@prb;
Print["One Month Return Probability Table"]
TableForm[Transpose[{prb,ret,1-prb}],TableHeadings->{None,{"Probability of     \nLower Return","Percent     \nReturn","Probability of   \nHigher Return"}}]

Print["Dividend History"]
Block[{$DateStringFormat={"MonthNameShort"," ","Day"," ","Year"}},TableForm[{DateString[#1],#2}&@@@FinancialData[symbol,"Dividend",start],TableHeadings->{None, {"Date            ","Dividend"}}]]

Print["Buy strategy: probability of market price less than value at one month.\n(Based on change from last low or last close.)"]
TableForm[Round[100{Last[lo][[2]] Exp[SQuantile[#,month1,1]&/@{0.05,0.1,0.2,0.25,0.3,0.4}],
Last[cl][[2]] Exp[SQuantile[#,month1,1]&/@{0.05,0.1,0.2,0.25,0.3,0.4}]}]/100.,TableHeadings->{{"Last Low","Last Close"},{"0.05","0.10","0.20","0.25","0.30","0.40"}}]
Print["Low  ",Min[Transpose[lo][[2]]],"  Last  ",Last[cl]]
Print["Probability of price less than low:  ",SCDF[Log[Min[Transpose[lo][[2]]]/Last[cl][[2]]],month1,1]]

Print["Sell strategy: probability of market price greater than value at one month.\n(Based on change from last high or last close.)"]
TableForm[Round[100{Last[hi][[2]] Exp[SQuantile[#,month1,1]&/@{0.95,0.9,0.8,0.75,0.7,0.6}],
Last[cl][[2]] Exp[SQuantile[#,month1,1]&/@{0.95,0.9,0.8,0.75,0.7,0.6}]}]/100.,TableHeadings->{{"Last High","Last Close"},{"0.05","0.10","0.20","0.25","0.30","0.40"}}]
Print["High  ",Max[Transpose[hi][[2]]],"  Last  ",Last[cl][[2]]]
Print["Probability of price greater than high:  ",1- SCDF[Log[Max[Transpose[hi][[2]]]/Last[cl][[2]]],month1,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["mathestate", {txcolor, Bold, Larger}]], "http://www.mathestate.com"], {0, 0}]];
t3 = Graphics[Text[Hyperlink[Framed[Style["Download Notebook", {txcolor, Bold, Larger}]], "../sa/StableStockAnalyzerM7.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 2009 mathestate    Sun 4 Jan 2009