Return to Answer

I am improved formatting

Source Link

edit approved Sep 22, 2016 at 21:10

9.3k
5
40
97

I rewrote quite a few things... manually specifying the mixture, and setting very low iteration and precision goals because it hangs for what seems like an eternity. Importantly I also specified assumptions on the distribution:

sas[\[Mu]_sas[μ_, \[Sigma]_σ_, skew_, kurt_, 
  z_] := ((1 + ((z - \[Mu]μ)/\[Sigma]σ)^2)^(-(1/2)) kurt Cosh[
     kurt ArcSinh[(z - \[Mu]μ)/\[Sigma]]σ] - 
      skew] Exp[-(1/2) Sinh[
        kurt ArcSinh[(z - \[Mu]μ)/\[Sigma]]σ] - skew]^2])/(Sqrt[
     2 \[Pi]]π] \[Sigma]σ)

(*dist=MixtureDistribution[{p,1-p},{sas[\[Mu]1sas[μ1,\[Sigma]1σ1,skew1,kurt1],\
sas[\[Mu]2sas[μ2,\[Sigma]2σ2,skew2,kurt2]}]*)
dist[p_, \[Mu]1_μ1_, \[Mu]2_μ2_, \[Sigma]1_σ1_, \[Sigma]2_σ2_, skew1_, skew2_, 
  kurt1_, kurt2_] := 
 ProbabilityDistribution[
  p*sas[\[Mu]1p*sas[μ1, \[Sigma]1σ1, skew1, kurt1, z] + (1 - p)*
    sas[\[Mu]2sas[μ2, \[Sigma]2σ2, skew2, kurt2, z], {z, -Infinity, Infinity},
   Assumptions -> {\[Sigma]1σ1 > 0, \[Sigma]2σ2 > 0, skew1 >= 0, 
    skew2 >= 0, kurt1 >= 0, kurt2 >= 0, 0 <= p <= 1}]


param = FindDistributionParameters[data, 
  dist[p, \[Mu]1μ1, \[Mu]2μ2, \[Sigma]1σ1, \[Sigma]2σ2, skew1, skew2, kurt1, 
   kurt2], {{\[Mu]1μ1, -0.2}, {\[Sigma]1σ1, 0.7}, {skew1, 0.3}, {kurt1, 
    1.}, {\[Mu]2μ2, 1.5}, {\[Sigma]2σ2, 0.5}, {skew2, 0.}, {kurt2, 
    1.}, {p, 0.25}}, 
  ParameterEstimator -> {"MaximumLikelihood", 
    Method -> {"NMaximize", PrecisionGoal -> 1, MaxIterations -> 5}}]
Show[Histogram[data, Automatic, "PDF"], 
 Plot[PDF[dist[p, \[Mu]1μ1, \[Mu]2μ2, \[Sigma]1σ1, \[Sigma]2σ2, skew1, skew2, 
     kurt1, kurt2] /. param, 
   z], {z, -2, 3}], PlotRange -> All]

enter image description here

sas[\[Mu]_, \[Sigma]_, skew_, kurt_, 
  z_] := ((1 + ((z - \[Mu])/\[Sigma])^2)^(-(1/2)) kurt Cosh[
     kurt ArcSinh[(z - \[Mu])/\[Sigma]] - 
      skew] Exp[-(1/2) Sinh[
        kurt ArcSinh[(z - \[Mu])/\[Sigma]] - skew]^2])/(Sqrt[
     2 \[Pi]] \[Sigma])

(*dist=MixtureDistribution[{p,1-p},{sas[\[Mu]1,\[Sigma]1,skew1,kurt1],\
sas[\[Mu]2,\[Sigma]2,skew2,kurt2]}]*)
dist[p_, \[Mu]1_, \[Mu]2_, \[Sigma]1_, \[Sigma]2_, skew1_, skew2_, 
  kurt1_, kurt2_] := 
 ProbabilityDistribution[
  p*sas[\[Mu]1, \[Sigma]1, skew1, kurt1, z] + (1 - p)*
    sas[\[Mu]2, \[Sigma]2, skew2, kurt2, z], {z, -Infinity, Infinity},
   Assumptions -> {\[Sigma]1 > 0, \[Sigma]2 > 0, skew1 >= 0, 
    skew2 >= 0, kurt1 >= 0, kurt2 >= 0, 0 <= p <= 1}]


param = FindDistributionParameters[data, 
  dist[p, \[Mu]1, \[Mu]2, \[Sigma]1, \[Sigma]2, skew1, skew2, kurt1, 
   kurt2], {{\[Mu]1, -0.2}, {\[Sigma]1, 0.7}, {skew1, 0.3}, {kurt1, 
    1.}, {\[Mu]2, 1.5}, {\[Sigma]2, 0.5}, {skew2, 0.}, {kurt2, 
    1.}, {p, 0.25}}, 
  ParameterEstimator -> {"MaximumLikelihood", 
    Method -> {"NMaximize", PrecisionGoal -> 1, MaxIterations -> 5}}]
Show[Histogram[data, Automatic, "PDF"], 
 Plot[PDF[dist[p, \[Mu]1, \[Mu]2, \[Sigma]1, \[Sigma]2, skew1, skew2, 
     kurt1, kurt2] /. param, 
   z], {z, -2, 3}], PlotRange -> All]

enter image description here

sas[μ_, σ_, skew_, kurt_, 
  z_] := ((1 + ((z - μ)/σ)^2)^(-(1/2)) kurt Cosh[
     kurt ArcSinh[(z - μ)/σ] - 
      skew] Exp[-(1/2) Sinh[
        kurt ArcSinh[(z - μ)/σ] - skew]^2])/(Sqrt[
     2 π] σ)

(*dist=MixtureDistribution[{p,1-p},{sas[μ1,σ1,skew1,kurt1],\
sas[μ2,σ2,skew2,kurt2]}]*)
dist[p_, μ1_, μ2_, σ1_, σ2_, skew1_, skew2_, 
  kurt1_, kurt2_] := 
 ProbabilityDistribution[
  p*sas[μ1, σ1, skew1, kurt1, z] + (1 - p)*
    sas[μ2, σ2, skew2, kurt2, z], {z, -Infinity, Infinity},
   Assumptions -> {σ1 > 0, σ2 > 0, skew1 >= 0, 
    skew2 >= 0, kurt1 >= 0, kurt2 >= 0, 0 <= p <= 1}]


param = FindDistributionParameters[data, 
  dist[p, μ1, μ2, σ1, σ2, skew1, skew2, kurt1, 
   kurt2], {{μ1, -0.2}, {σ1, 0.7}, {skew1, 0.3}, {kurt1, 
    1.}, {μ2, 1.5}, {σ2, 0.5}, {skew2, 0.}, {kurt2, 
    1.}, {p, 0.25}}, 
  ParameterEstimator -> {"MaximumLikelihood", 
    Method -> {"NMaximize", PrecisionGoal -> 1, MaxIterations -> 5}}]
Show[Histogram[data, Automatic, "PDF"], 
 Plot[PDF[dist[p, μ1, μ2, σ1, σ2, skew1, skew2, 
     kurt1, kurt2] /. param, 
   z], {z, -2, 3}], PlotRange -> All]

enter image description here

Source Link

created May 24, 2015 at 19:43

Histograms

2.3k
13
21

sas[\[Mu]_, \[Sigma]_, skew_, kurt_, 
  z_] := ((1 + ((z - \[Mu])/\[Sigma])^2)^(-(1/2)) kurt Cosh[
     kurt ArcSinh[(z - \[Mu])/\[Sigma]] - 
      skew] Exp[-(1/2) Sinh[
        kurt ArcSinh[(z - \[Mu])/\[Sigma]] - skew]^2])/(Sqrt[
     2 \[Pi]] \[Sigma])

(*dist=MixtureDistribution[{p,1-p},{sas[\[Mu]1,\[Sigma]1,skew1,kurt1],\
sas[\[Mu]2,\[Sigma]2,skew2,kurt2]}]*)
dist[p_, \[Mu]1_, \[Mu]2_, \[Sigma]1_, \[Sigma]2_, skew1_, skew2_, 
  kurt1_, kurt2_] := 
 ProbabilityDistribution[
  p*sas[\[Mu]1, \[Sigma]1, skew1, kurt1, z] + (1 - p)*
    sas[\[Mu]2, \[Sigma]2, skew2, kurt2, z], {z, -Infinity, Infinity},
   Assumptions -> {\[Sigma]1 > 0, \[Sigma]2 > 0, skew1 >= 0, 
    skew2 >= 0, kurt1 >= 0, kurt2 >= 0, 0 <= p <= 1}]


param = FindDistributionParameters[data, 
  dist[p, \[Mu]1, \[Mu]2, \[Sigma]1, \[Sigma]2, skew1, skew2, kurt1, 
   kurt2], {{\[Mu]1, -0.2}, {\[Sigma]1, 0.7}, {skew1, 0.3}, {kurt1, 
    1.}, {\[Mu]2, 1.5}, {\[Sigma]2, 0.5}, {skew2, 0.}, {kurt2, 
    1.}, {p, 0.25}}, 
  ParameterEstimator -> {"MaximumLikelihood", 
    Method -> {"NMaximize", PrecisionGoal -> 1, MaxIterations -> 5}}]
Show[Histogram[data, Automatic, "PDF"], 
 Plot[PDF[dist[p, \[Mu]1, \[Mu]2, \[Sigma]1, \[Sigma]2, skew1, skew2, 
     kurt1, kurt2] /. param, 
   z], {z, -2, 3}], PlotRange -> All]

enter image description here