home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1987 / 09 / statis / dichte.inc < prev    next >
Encoding:
Text File  |  1987-07-01  |  4.8 KB  |  124 lines
  1. {***************************************************************************}
  2. {*                               DICHTE.INC                                *}
  3. {*                          Wahrscheinlichkeiten                           *}
  4. {***************************************************************************}
  5. FUNCTION dichte (v_fkt: Verteilungstyp; p: Parametervector; x: REAL): REAL;
  6.  
  7. VAR a, b  : REAL;
  8.     p_vec : Parametervector;
  9.  
  10. BEGIN
  11.   CASE v_fkt OF
  12.    sta  :  BEGIN  dichte := Exp(-x*x/2.0)/Sqrt(2.0*Pi); END;
  13.    nor  :  dichte := dichte(sta,p_vec,((x-p[1])/p[2]));
  14.    bin  :  BEGIN
  15.              IF p[2] > 0.5 THEN
  16.                BEGIN  p[2] := 1.0-p[2];  x := p[1]-x;  END;
  17.              IF x < 0.0 THEN dichte := 0.0;
  18.              IF x >= 0.0 THEN
  19.                IF p[1] > 48.0 THEN
  20.                  BEGIN
  21.                    p_vec[1] := p[1]*p[2];
  22.                    p_vec[2] := Sqrt(p[1]*p[2]*(1.0-p[2]));
  23.                    dichte := dichte(nor,p_vec,(x+0.5)) -
  24.                              dichte(nor,p_vec,(x-0.5));
  25.                  END
  26.                ELSE
  27.                  dichte := binkoeff(p[2],x)*power(p[2],x)*power((1.0-p[2]),
  28.                                    (p[1]-x));
  29.            END;
  30.    hyp  :  BEGIN
  31.              a := 0.0;
  32.              IF (p[3]+p[2]-p[1]) > a THEN a := p[3]+p[2]-p[1];
  33.              b := p[3];
  34.              IF p[2] < p[3] THEN b := p[2];
  35.              IF (x >= a) AND (x <= b) THEN
  36.                IF ((p[2]/p[1]) > 0.1) AND ((p[2]/p[1]) < 0.9) AND
  37.                   ((p[3]/p[1]) < 0.05) AND (p[3] > 10.0) THEN
  38.                  BEGIN
  39.                    p_vec[1] := p[3];  p_vec[2] := p[2]/p[1];
  40.                    dichte := dichte(bin,p_vec,x);
  41.                  END
  42.                ELSE IF ((p[2]/p[1]) > 0.1) AND ((p[2]/p[1]) < 0.9) AND
  43.                        ((p[3]/p[1]) < 0.05) AND (p[3] > 30.0) THEN
  44.                  BEGIN
  45.                    a := (p[2]/p[1]); b := (p[1]-p[3])/(p[1]-1.0);
  46.                    p_vec[1] := p[3]*a; p_vec[2] := p[3]*a*(1.0-a)*b;
  47.                    dichte := dichte(nor,p_vec,(x+0.5)) -
  48.                              dichte(nor,p_vec,(x-0.5));
  49.                  END
  50.              ELSE
  51.                BEGIN
  52.                  a := binkoeff(p[2],x)*binkoeff((p[1]-p[2]),(p[3]-x));
  53.                  b := binkoeff(p[1],p[3]);
  54.                  dichte := a/b;
  55.                END
  56.              ELSE dichte := 0.0;
  57.            END;
  58.   expo  :  BEGIN
  59.              IF x >= 0.0 THEN dichte := p[1]*Exp(-p[1]*x) ELSE dichte := 0.0;
  60.            END;
  61.   gch   :  BEGIN
  62.              IF x > 0.0 THEN dichte := 1.0/(p[2]-p[1]) ELSE dichte := 0.0;
  63.            END;
  64.    poi  :  BEGIN
  65.              IF x < 0.0 THEN dichte := 0.0;
  66.              IF x >= 0.0 THEN
  67.               IF p[1] >= 14.0 THEN
  68.                 BEGIN
  69.                   p_vec[1] := p[1]; p_vec[2] := Sqrt(p[1]);
  70.                   dichte := dichte(nor,p_vec,(x+0.5)) -
  71.                             dichte(nor,p_vec,(x-0.5));
  72.                 END
  73.               ELSE dichte := power(p[1],x)/fac(x)*Exp(-p[1])
  74.            END;
  75.    stu  :  BEGIN
  76.              IF p[1] > 0.0 THEN
  77.                IF p[1] > 60.0 THEN dichte := dichte(sta,p_vec,x)
  78.                ELSE
  79.                BEGIN
  80.                  a := gamma((p[1]+1.0)/2.0)*power((1.0+Sqr(x)/p[1]),
  81.                                                   -(p[1]+1.0)/2.0);
  82.                  dichte := a/gamma(p[1]/2.0)/Sqrt(p[1]*Pi);
  83.                END;
  84.            END;
  85.    chi  :  BEGIN
  86.              IF x <= 0.0 THEN dichte := 0.0;
  87.              IF x > 0.0 THEN
  88.                IF p[1] > 100.0 THEN
  89.                  BEGIN
  90.                    p_vec[1] := p[1]; p_vec[2] := Sqrt(2.0*p[1]);
  91.                    dichte := dichte(nor,p_vec,x);
  92.                  END
  93.                ELSE
  94.                  BEGIN
  95.                    a := power(x,(p[1]-2.0)/2.0)/gamma(p[1]/2.0);
  96.                    b := Exp(-x/2.0)/power(2.0,p[1]/2.0);
  97.                    dichte := a*b;
  98.                  END
  99.            END;
  100.    fis  :  BEGIN
  101.              IF ((p[1] > 1.0) AND (p[2] > 200.0)) THEN
  102.                BEGIN
  103.                  p_vec[1] := p[1];
  104.                  dichte := dichte(chi,p_vec,x);
  105.                END
  106.              ELSE
  107.                BEGIN
  108.                  a := gamma((p[1]+p[2])/2.0) /
  109.                       gamma(p[1]/2.0)/gamma(p[2]/2.0);
  110.                  b := power(x,p[1]/2.0-1.0) /
  111.                       power(x*p[1]+p[2],(p[1]+p[2])/2.0);
  112.                  dichte := a*b*power(p[1],p[2]/2.0)*power(p[2],p[2]/2.0);
  113.                END;
  114.            END;
  115.    ber  :  BEGIN
  116.              IF x = 0.0 THEN dichte := 1.0-p[1]
  117.              ELSE IF x = 1.0 THEN dichte := p[1]
  118.              ELSE dichte := 0.0;
  119.            END;
  120.   END;
  121. END;
  122. {---------------------------------------------------------------------------}
  123. {                              Ende DICHTE.INC                              }
  124.