LogReturn[data_] := Differences[Log[N[data]]];
Clear[BearWatchPlot];
BearWatchPlot[timeseries_,{lo_,hi_}]:=Module[{m,mn,mx,cn,cx,lr,extr,qn,rticks,axr},
lr= LogReturn[timeseries[[All,2]]];
qn=Quantile[lr,{lo,hi}];
extr=Select[Transpose[{Rest[timeseries[[All,1]]],lr}],!qn[[1]]<#[[2]]<qn[[2]]&];
mx=Max[extr[[All,2]]];
mn=Min[extr[[All,2]]];
cx=Max[timeseries[[All,2]]];
cn=Min[timeseries[[All,2]]];
m=(cx-cn)/(mx-mn);
axr=Round[100Mean[Abs[{mx,mn}]]];
If[OddQ[axr],axr=axr-1];
axr=axr/100.;
rticks=Table[{(i-mn) m+cn,Chop[i]},{i, -axr,axr,axr/2}];
DateListPlot[{timeseries,{#1,#2 m-m mn +cn}&@@@extr},Frame->True,Axes->False,PlotRange->All,Joined->{True,False},PlotStyle->{Blue,Red},FrameTicks-> {Automatic,Automatic,None,rticks},PlotLabel->symbol<>" with Extreme Returns\n"<>"{ "<>ToString[lo]<>", "<>ToString[hi]<>"}",FrameLabel-> {"Year","Price",None,"Log Return"}]
];
BearWatchLogPlot[timeseries_,{lo_,hi_}]:=Module[{logseries,m,mn,mx,cn,cx,lr,extr,qn,rticks,axr},
lr= LogReturn[timeseries[[All,2]]];
qn=Quantile[lr,{lo,hi}];
extr=Select[Transpose[{Rest[timeseries[[All,1]]],lr}],!qn[[1]]<#[[2]]<qn[[2]]&];
mx=Max[extr[[All,2]]];
mn=Min[extr[[All,2]]];
logseries={#1,Log[#2]}&@@@timeseries;
cx=Max[logseries[[All,2]]];
cn=Min[logseries[[All,2]]];
m=(cx-cn)/(mx-mn);
axr=Round[100Mean[Abs[{mx,mn}]]];
If[OddQ[axr],axr=axr-1];
axr=axr/100.;
rticks=Table[{(i-mn) m+cn,Chop[i]},{i, -axr,axr,axr/2}];
DateListPlot[{logseries,{#1,#2 m-m mn +cn}&@@@extr},Frame->True,Axes->False,PlotRange->All,Joined->{True,False},PlotStyle->{Blue,Red},FrameTicks-> {Automatic,Automatic,None,rticks},PlotLabel->symbol<>" with Extreme Returns\n"<>"{ "<>ToString[lo]<>", "<>ToString[hi]<>"}",FrameLabel-> {"Year","Log Price",None,"Log Return"}]
];

Extreme Events

In the section on market crashes we developed the idea that high volatility would lead to more extreme events.  Ultimately an extreme event would be significant enough to lead to a bear market.  Now we look at extreme events without consideration of what kind of statistical distribution they might have.

symbol="SPY";
data=FinancialData[symbol,{1995,1,1}];
CellPrint[TextCell["Data from, "<>((DateString[#1,"DateShort"]<>", Price "<>ToString[#2])&@@@{First[data]})[[1]]<>", through "<>((DateString[#1,"DateShort"]<>", Price "<>ToString[#2])&@@@{Last[data]})[[1]]<>".","Text"]];
BearWatchPlot[data,{0.02,0.98}]

Data from, Tue 3 Jan 1995, Price 34.92, through Fri 12 Aug 2011, Price 118.12.

The graph above shows the price time series with the price scale on the left.  The red dots show the days on which extreme returns outside the quantile range [0.02, 0.98] occurred.  The scale on the right shows the magnitude of these log returns.  The graph rather clearly suggests that the extremes are clustered, consistent with the idea that the distribution of returns is not stationary.  This kind of graphic may be more useful in spotting trouble than, looking at volatility averaged over some period.  Note, however, that extreme returns began to show up three years before the market peak in 2000.

The graph below shows the same quantile range for the Dow Jones Industrial Average time series, but log price is plotted to better show the volatility over the longer time frame.

symbol="^DJI";
data=FinancialData[symbol,All];
CellPrint[TextCell["Data from, "<>((DateString[#1,"DateShort"]<>", Price "<>ToString[#2])&@@@{First[data]})[[1]]<>", through "<>((DateString[#1,"DateShort"]<>", Price "<>ToString[#2])&@@@{Last[data]})[[1]]<>".","Text"]];
symbol="DJIA";
BearWatchLogPlot[data,{0.02,0.98}]

Data from, Mon 1 Oct 1928, Price 240.01, through Fri 12 Aug 2011, Price 11269..

The advantage of this method is that it makes no assumptions about the log return distribution, but just works with the empirical quantiles of the data set.

Try this link to show similar plots interactively for individual securities.

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["Next", {txcolor, Bold, Larger}]],  "../r10/HittingTime.html"], {5, 0}]];

t4 = Graphics[Text[Hyperlink[Framed[Style["Previous", {txcolor, Bold, Larger}]],  "../r08/Crash.html"], {0,0}]];

Show[ t1, t2,t4, ImageSize -> 500]
CellPrint[TextCell["\n\n© Copyright " <>ToString[DateList[][[1]]]<>" mathestate    "<>DateString[DateList[],"DateShort"], "Text"]]

© Copyright 2011 mathestate    Sun 14 Aug 2011