home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1987 / 09 / statis / quantile.inc < prev    next >
Encoding:
Text File  |  1987-07-01  |  2.6 KB  |  67 lines
  1. {***************************************************************************}
  2. {*                              QUANTILE.INC                               *}
  3. {*               Umkehrfunktionen der Standardverteilungen                 *}
  4. {***************************************************************************}
  5. FUNCTION quantil (v_fkt: Verteilungstyp; p: Parametervector; x: REAL): REAL;
  6.                                              { 0 <= x <= 1  fuer alle x !!! }
  7.  
  8. VAR a, b, c, d, dummy1, dummy2 : REAL;
  9.     signum                     : BOOLEAN;
  10.     p_vec                      : Parametervector;
  11.  
  12.  
  13.   FUNCTION korrektur (x : REAL) : REAL;
  14.   CONST a0 = 2.515517;
  15.         a1 = 0.802853;
  16.         a2 = 0.010328;
  17.         b1 = 1.432788;
  18.         b2 = 0.189269;
  19.         b3 = 0.001308;
  20.  
  21.   VAR t : REAL;
  22.  
  23.   BEGIN
  24.     t := Sqrt(-2.0*Ln(1.0-x));
  25.     korrektur := t-(a0+a1*t+a2*t*t)/(1.0+b1*t+b2*t*t+b3*t*t*t);
  26.   END;
  27.  
  28. BEGIN  { quantil }
  29.   CASE v_fkt OF
  30.    expo : BEGIN  quantil := -1.0*(Ln(1.0-x))/p[1];  END;
  31.    sta  : BEGIN
  32.             IF x <= 0.5 THEN BEGIN signum := TRUE; dummy1 := 1.0-x; END
  33.             ELSE BEGIN signum := FALSE; dummy1 := x; END;
  34.             IF NOT signum THEN quantil := korrektur(dummy1)
  35.             ELSE quantil := -1.0*korrektur(dummy1);
  36.           END;
  37.    nor  : BEGIN
  38.             dummy1 := quantil(sta,p_vec,x); quantil := p[1]+dummy1*p[2];
  39.           END;
  40.    stu  : BEGIN
  41.             IF x <= 0.5 THEN BEGIN signum := TRUE; dummy1 := 1.0-x; END
  42.             ELSE BEGIN signum := FALSE; dummy1 := x; END;
  43.             c := (p[1]-5.0/6.0)/Sqr(p[1]-2.0/3.0+0.1/p[1]);
  44.             dummy2 := Sqrt(p[1]*Exp(c*Sqr(korrektur(dummy1)))-p[1]);
  45.             IF NOT signum THEN quantil := dummy2
  46.             ELSE quantil := -1.0*dummy2;
  47.           END;
  48.    chi  : BEGIN
  49.             dummy1 := 1.0-2.0/(9.0*p[1])+korrektur(x)*Sqrt(2.0/(9.0*p[1]));
  50.             quantil := p[1]*dummy1*dummy1*dummy1;
  51.           END;
  52.    fis  : BEGIN
  53.             IF x <= 0.5 THEN BEGIN signum := TRUE; dummy1 := 1.0-x; END
  54.             ELSE BEGIN signum := FALSE; dummy1 := x; END;
  55.             c := (Sqr(korrektur(dummy1))-3.0)/6.0;
  56.             d := 1.0/(p[1]-1.0)+1.0/(p[2]-1.0);
  57.             b := 2.0*(1.0/(p[1]-1.0)-1.0/(p[2]-1.0))*(c+5.0/6.0-d/3.0);
  58.             a := Sqrt(2.0*d+c*d*d);
  59.             dummy2 := Exp(korrektur(dummy1)*a+b);
  60.             IF NOT signum THEN quantil := dummy2
  61.             ELSE quantil := 1.0/dummy2;
  62.           END;
  63.   END;
  64. END;
  65. {---------------------------------------------------------------------------}
  66. {                             Ende QUANTILE.INC                             }
  67.