Empirical Characteristic Function

Needs["StableM`"];
SetOptions[FourierTransform,FourierParameters-> {1,1}];
SetOptions[InverseFourierTransform,FourierParameters-> {1,1}];
SetOptions[Fourier, FourierParameters -> {-1,1}];
SetOptions[InverseFourier, FourierParameters -> {-1,1}];
ReOrder::usage = "ReOrder[list] reorders a frequency domain list for the time domain and vice versa.  If Length[list] is odd the output list will be truncated to the next smallest integer.";
XTable::usage="XTable[SR, N] puts out a list of x values that correspond to the stable x-axis in the time domain for a given length, N, and SR of the DFFT list.";
DFTCF::usage= "DFTCF[cf,SR,N] puts out a discrete FT of a distribution specified by the characteric function cf in the frequency domain compatible with FourierParameters -> {-1, 1}.  SR is the sampling rate; SR is greater than 0.  N is the number of points and must be even.  The output is scaled ready for inversion.";
CF1c::usage= "CF1c[u, α, β, γ, δ] outputs a compiled version of the S(α, β, γ, δ; 1) characteristic function.  All the inputs must be real numbers.";
ReOrder=With[{n=Length[#]},Join[Drop[#,Floor[n/2]],Drop[#,-Floor[n/2]]]]&;
XTable  = Compile[{SR, {N,_Integer}},Module[{n},
n=2 Floor[N/2];
Range[-n/2,n/2-1,1]/(SR)]];
DFTCF [cf_,SR_,n_Integer]:=Module[{rlist,n2},
n2=Floor[n/2];
rlist=2. Pi SR/n Join[Range[0,n2-1],Range[-n2,-1]];
Map[cf[ #]&,rlist]SR/n
	];
CF1c=Compile[{#1,#2,#3,#4,#5},If[#1==0,1,If[#2==1,E^(I*#5*#1-#4*Abs[#1]*((2*I*#3*Log[Abs[#1]]*Sign[#1])/Pi+1)),E^(I*#1*#5-Abs[#1]^#2*#4^#2*(1-I*Sign[#1]*#3*Tan[(Pi*#2)/2]))]]];

An empirical characteristic function can be defined as below, where {(Subscript[X, 1]), (Subscript[X, 2]), ... (Subscript[X, n])} is a sample of i.i.d. random variables.  The technique and its robustness is described by Feuerverger (1977, 1981).

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

Once the empirical characteristic function is calculated, it can be sampled at discrete intervals on t, just like any functional form and can be used with the FFT.  The function EmpiricalCF sets up the function which is designed to be used in the function, DFTCF.

CellPrint[TextCell[CFs::"usage","Text"]]

CFs[t, sample] generates a sample characteristic function(t) of the data sample

First a stable random sample is created for the demonstration.

parm = {1.7, 0.5, 1, 0};
s = SRandom[500, parm];

parm={1.7,0.5,1,0};
s=SRandom[500,parm];

The Scale is chosen appropriately for the scale of γ = 1.  The FFT is calculated and the plots show the absolute value and phase of the Fourier transform.  The density function is then computed taking the inverse FFT.

ecf = DFTCF[CFs[#1, s] &, 16, 8192];
ListPlot[Abs[ecf], PlotRange -> All, PlotStyle -> Blue, PlotLabel -> "Abs[ecf]"]
ListPlot[Arg[ecf], PlotRange -> All, PlotStyle -> Blue, PlotLabel -> "Arg[ecf]"]
pdf = Re[Chop[InverseFourier[ecf]]];
g1 = ListPlot[Transpose[{XTable[16, 8192], ReOrder[pdf]}], PlotRange -> {{-15, 15}, All}, PlotStyle -> Blue, PlotLabel -> "Empirical Density"]

ecf=DFTCF[CFs[#1,s]&,16,8192];
ListPlot[Abs[ecf],PlotRange->All,PlotStyle->Blue,PlotLabel-> "Abs[ecf]"]
ListPlot[Arg[ecf],PlotRange->All,PlotStyle->Blue,PlotLabel-> "Arg[ecf]"]
pdf=Re[Chop[InverseFourier[ecf]]];
g1=ListPlot[Transpose[{XTable[16,8192],ReOrder[pdf]}],PlotRange->{{-15,15},All},PlotStyle->Blue,PlotLabel-> "Empirical Density"]

The absolute amplitudes and the density show a lot of high frequency oscillation and beg to be smoothed.  It is easy to filter something in the transform domain.

sfilt = DFTCF[CharacteristicFunction[ NormalDistribution[0, 0.25 Sqrt[2]], #] &, 16, 8192];
scale = 8192/16;
pdf1 = Chop[InverseFourier[scale  sfilt ecf]];
g2 = ListPlot[Transpose[{XTable[16, 8192], ReOrder[pdf1]}], PlotRange -> {{-15, 15}, All}, PlotStyle -> Blue];
g3 = Plot[SPDF[x, parm], {x, -15, 15}, PlotRange -> All, PlotStyle -> Red, PerformanceGoal -> "Speed"];
Show[g2, g3]

sfilt=DFTCF[CharacteristicFunction[ NormalDistribution[0,0.25 Sqrt[2]],#] &,16,8192];
scale=8192/16;
pdf1=Chop[InverseFourier[scale  sfilt ecf]];
g2=ListPlot[Transpose[{XTable[16,8192],ReOrder[pdf1]}],PlotRange->{{-15,15},All},PlotStyle->Blue];
g3=Plot[SPDF[x,parm],{x,-15,15},PlotRange->All,PlotStyle->Red,PerformanceGoal->"Speed"];
Show[g2,g3]

Choosing the right filter, however, is difficult.  Interestingly if the empirical characteristic function is multiplied by itself to create a distribution of summed random variables, it be comes smooth without filtering.  Here is the distribution of the sum of three random variables.  Since we are using a stable distribution we can calculate what the distribution of the sum of three random variables would be, shown in red.

pdf1 = Re[Chop[InverseFourier[(scale ecf)^3]]]/scale;
g2 = ListPlot[Transpose[{XTable[16, 8192], ReOrder[pdf1]}], PlotRange -> {{-15, 15}, All}, PlotStyle -> Blue];
g3 = Plot[SPDF[x, {1.7, 0.5, 3^(1/1.7), 0}], {x, -15, 15}, PerformanceGoal -> "Speed", PlotStyle -> Red];
Show[g2, g3]

pdf1=Re[Chop[InverseFourier[(scale ecf)^3]]]/scale;
g2=ListPlot[Transpose[{XTable[16,8192],ReOrder[pdf1]}],PlotRange->{{-15,15},All},PlotStyle->Blue];
g3=Plot[SPDF[x,{1.7,0.5,3^(1/1.7),0}],{x,-15,15},PerformanceGoal->"Speed",PlotStyle->Red];
Show[g2,g3]

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