Needs["StableM`"];
ScaleS1[n_,s1params_List] := {s1params[[1]],s1params[[2]],n^(1/s1params[[1]])s1params[[3]],n s1params[[4]]};

Stable Convolution

The convolution of two statistical densities gives the density of the sum of random variables from the two distributions.  A convolution of a density with itself gives the density of the sum of two random variables from the distribution.  The convolution of a stable distribution with itself, gives a stable distribution with the same shape and skewness, {α, β}.  In the 1-parameterization the changes to γ and δ are straight forward.  Where n is the number of convolutions, the scale and shift changes with convolution are:

(Subscript[γ, conv])=(n^(1/α)) γ

(Subscript[δ, conv])=n δ

But convolution is also a smoothing operation, suggesting that there may be a place for this in data analysis.  Consider the empirical characteristic function:

ecf(t)=(1/n)(∑_(j=1)^n)(e^(i t (Subscript[X, j])))

Below is the plot of a stable characteristic function in three dimensions in blue.  In red is the plot of the empirical characteristic function of a stable random sample with the same parameters.  The sample size is 1000.

s= SRandom[1000,{1.3,1}];g1=ParametricPlot3D[scf=StableCF1[t,{1.3,1,1,0}];{t,Re[scf],Im[scf]},{t,-10,10},PlotRange->All, BoxRatios-> {2,1,1},PlotLabel-> "Stable Characteristic Function\nα = 1.3\nβ = 1"];
g2=ParametricPlot3D[scf=CFs[t,s];{t,Re[scf],Im[scf]},{t,-10,10},PlotRange->All,PlotStyle-> Red, BoxRatios-> {2,1,1}];
Show[g1,g2]

Each random variable can be imagined as an orbit in the complex plane.  The orbit of the characteristic function of a single random variable is the unit circle with the value of the random variable determining the speed and direction of the orbit.  When you take the mean of these orbits, you have the orbit of the characteristic function.  Viewing the above plot only in the complex plane, you see the orbit at t = 0 at position 1 + 0 i, as t goes to ±∞ the orbit spirals to the origin.  Looking at the picture it is clear that the tail of the empirical characteristic function is not so smooth at the portion near t = 0.

parm=Quiet[SFit[s]];g1=ParametricPlot[scf=StableCF1[t,parm];{Re[scf],Im[scf]},{t,-10,10},PlotRange->All,PlotLabel-> "Stable Characteristic Function\nα = 1.3\nβ = 1"];
g2=ParametricPlot[scf=CFs[t,s];{Re[scf],Im[scf]},{t,-10,10},PlotRange->All,PlotStyle-> Red,PlotLabel-> "Stable Characteristic Function\nα = 1.3\nβ = 1"];
Show[g2,g1]

The graph below shows the empirical characteristic function convolved with itself.  There is smoothing of the tail, but some distortion of the mid portion of the function.

g1=ParametricPlot[scf=StableCF1[t,ScaleS1[2,parm]];{Re[scf],Im[scf]},{t,-10,10},PlotRange->All];
g2=ParametricPlot[scf=CFs[t,s]^2;{Re[scf],Im[scf]},{t,-10,10},PlotRange->All,PlotStyle-> Red,PlotLabel-> "Stable Characteristic Function\nwith One Convolution\nα = 1.3\nβ = 1"];
Show[g2,g1]

The CFFit routine in StableM currently uses a convolution of the empirical characteristic function with a negative version of the sample to symmetrize the distribution for fitting α and γ, but it does not yet take advantage of the smoothing to use more of the tail of the characteristic function.  Below is a version CFFit1 that doubles the tail length.  Most of the time the fit is marginally better with this enhancement, but not usually so good as the much slower maximum likelihood fit.  The log likelihoods are shown for each of the fits.

cfs=StableM`Private`cfs;
Clear[CFFit1];
CFFit1[s_,type_Integer:1]:=Module[{soln,cc,s1,c,c0,c1,c2,i,t,a,d,d0,d1,d2,y,b,tval,cfval},
(*{a,b,c,d}={0,0,0,0};*)
(*symmetrized cf doesn't seem to add anything*)
(*c=Abs[FindRoot[Log[Chop[CFs[1/cc,s] CFs[-1/cc,s]]]+2,{cc,1}][[1]][[2]]];*)
c0=QuartileDeviation[s];
c=Abs[FindRoot[Log[Abs[CFs[1/cc,s] ]]+1,{cc,c0},AccuracyGoal->4,PrecisionGoal->4][[1]][[2]]];

(*get d0*)
d=Median[s];(*use median to move d closer to zero*)
d1= Arg[CFs[1,(s-d)/c]];(*doesn't work unless d close to zero*)
d=d+c  d1;
c0=c;
tval=Range[2 32]/32;

c1=1;c2=2;
i=0;
While[Abs[c2-1]>10^-8&&i<20,i++;
c=c c1;
cfval={Log[#],Log[-Log[Chop[cfs[#,(s-d)/c] cfs[-#,(s-d)/c]]]]}&/@tval;
y=Fit[cfval,{t,1},t];
a=y[[2]][[1]];

c1=Exp[(y[[1]]-Log[2])/a];
c2= c1;
];
a=If[a≥2,2,a];

tval=Range[32]/32;
d0=d;

d1=0;d2=1;(*allows entry into while and preserves correct relation of b and d*)
While[Abs[d2]>10.^-8,
d=d+c  d1;
cfval={#,Arg[cfs[#,(s-d)/c]]/(# )}&/@tval;
y=Fit[cfval,{t^(a-1),1},t];
If[Abs[ y[[2]][[1]]/ Tan[Pi a/2]]>1,Break[]];
d1=y[[2]][[1]]+y[[1]];
d2=d1];


b= y[[2]][[1]]/ Tan[Pi a/2];
b=If[a≥2,0,b];
b=If[Abs[b]>1,Sign[b],b];
If[type==1,SConvert[{a,b,c,d},0,1],{a,b,c,d}]
];

p1 = CFFit[s]
p2 = CFFit1[s]

p1=CFFit[s]
p2=CFFit1[s]

SLogLikelihood[s, p1]
SLogLikelihood[s, p2]

SLogLikelihood[s,p1]
SLogLikelihood[s,p2]

p3 = SFit[s]
SLogLikelihood[s, p3]

p3=SFit[s]
SLogLikelihood[s,p3]

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}]], "../ft08/FFTInterpolation.html"], {0, -0.5}]];
t3 = Graphics[Text[Hyperlink[Framed[Style["Download Notebook", {txcolor, Bold, Larger}]], "../ft07/StableConvolution.nb"], {5, 0}]];
t4 = Graphics[Text[Hyperlink[Framed[Style["Previous", {txcolor, Bold, Larger}]], "../ft06/EmpiricalCF.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 2008 mathestate    Fri 7 Mar 2008