home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1987 / 09 / statis / correl.inc next >
Encoding:
Text File  |  1987-07-07  |  6.8 KB  |  177 lines
  1. {***************************************************************************}
  2. {*                               CORREL.INC                                *}
  3. {*                      Routinen fuer Korrelationstests                    *}
  4. {***************************************************************************}
  5. FUNCTION covariance (vec1, vec2 : vector) : REAL;
  6.  
  7. VAR i               : INTEGER;
  8.     xmw, ymw, dummy : REAL;
  9.  
  10. BEGIN
  11.   IF vec1.n = vec2.n THEN
  12.     BEGIN
  13.       mittel(vec1, xmw, dummy, dummy);
  14.       mittel(vec2, ymw, dummy, dummy);
  15.       dummy := 0;
  16.       FOR I := 1 TO vec1.n DO dummy := dummy + vec1.value[I]*vec2.value[I];
  17.       covariance := (dummy - vec1.n*xmw*ymw);
  18.     END
  19.   ELSE covariance := 0;
  20. END;
  21. {---------------------------------------------------------------------------}
  22. FUNCTION pearson (xvec, yvec : vector) : REAL;
  23.  
  24. VAR xsum1, xsum2, ysum1, ysum2, dummy, dummy2, help1, help2 : REAL;
  25.     I : INTEGER;
  26.  
  27. BEGIN
  28.   dummy := 0.0;  xsum1 := 0.0; xsum2 := 0.0; ysum1 := 0.0; ysum2 := 0.0;
  29.   FOR I := 1 TO xvec.n DO
  30.      BEGIN
  31.        dummy := dummy + xvec.value[I] * yvec.value[I];
  32.        xsum1 := xsum1 + xvec.value[I];
  33.        xsum2 := xsum2 + xvec.value[I] * xvec.value[I];
  34.        ysum1 := ysum1 + yvec.value[I];
  35.        ysum2 := ysum2 + yvec.value[I] * yvec.value[I];
  36.      END;
  37.   help1 := xsum1*xsum1/xvec.n;  help2 := ysum1*ysum1/yvec.n;
  38.   dummy2 := (xsum2 - help1)*(ysum2 - help2);
  39.   IF dummy2 > 0.0 THEN pearson := (dummy - xsum1*ysum1/xvec.n)/SQRT(dummy2)
  40.   ELSE WRITEln ('Produkt der Varianzen ist Null ! ');
  41. END;
  42. {---------------------------------------------------------------------------}
  43. { errechnet Korrelationsmatrizen für mehr als zwei Vektoren, also Matrizen  }
  44. PROCEDURE corr_matrix (xmat,ymat : datenmatrix; VAR corrmat : matrix);
  45.  
  46. VAR  i,j : INTEGER;
  47.  
  48. BEGIN
  49.   corrmat.z := xmat.z;   corrmat.s := ymat.z;
  50.   FOR I := 1 TO xmat.z DO
  51.     FOR J := 1 TO ymat.z DO
  52.       corrmat.ele[I,J] := pearson(xmat.zeile[I], ymat.zeile[J]);
  53. END;
  54. {---------------------------------------------------------------------------}
  55. {          Utility für Korrelationsberechnungen s. Literatur                }
  56. {          inv = false ===> Normalisierung: z :=arctanh(rxy)                }
  57. {          inv = true  ===> Ruecktransformierung                            }
  58. FUNCTION z_trans (rxy : REAL; inv : BOOLEAN) : REAL;
  59.  
  60. BEGIN
  61.   IF inv THEN z_trans := (EXP(2.0*rxy)-1.0)/(EXP(2.0*rxy)+1.0)
  62.   ELSE IF (1.0-ABS(rxy)) > 0.0 THEN z_trans := LN((1.0+rxy)/(1.0-rxy))/2.0;
  63. END;
  64. {---------------------------------------------------------------------------}
  65. PROCEDURE corrtest;
  66.  
  67. VAR test, alpha, h0, rxy, co, dummy : REAL;
  68.     vec1, vec2                      : vector;
  69.     tcu, tco                        : BOOLEAN;
  70.     seiten                          : INTEGER;
  71.     p                               : parametervector;
  72.  
  73. BEGIN
  74.   writeln;  WRITELN('Erster Datenvector :');  readvector(vec1);
  75.   writeln;  WRITELN('Zweiter Datenvector :');  readvector(vec2);
  76.   signifikanz(alpha);
  77.   nullhypothese(h0);
  78.   rxy := pearson(vec1, vec2);
  79.   seiten := 1;  tco := TRUE;   tcu := FALSE;
  80.   IF (1.0-ABS(rxy) > 0.0) AND (vec1.n > 3.0) THEN
  81.     IF h0 <> 0.0 THEN
  82.       BEGIN
  83.         test := z_trans(rxy,FALSE)-z_trans(h0,FALSE)-h0/(2.0*(vec1.n-1.0));
  84.         test := ABS(test*SQRT(vec1.n-3.0));
  85.         co := quantil(sta, p, 1.0-alpha);
  86.       END
  87.     ELSE
  88.       BEGIN
  89.         test := rxy*SQRT(vec1.n-2.0)/SQRT(1.0-rxy*rxy);
  90.         p[1] := vec1.n-2.0;
  91.         co := quantil(stu, p, 1.0-alpha);
  92.       END;
  93.   entscheidung(test, alpha, h0, dummy, co, seiten, tcu, tco);
  94.   warten;
  95. END;
  96. {---------------------------------------------------------------------------}
  97. PROCEDURE corrkonfidenz;
  98.  
  99. VAR cu, co, alpha, rxy, dummy : REAL;
  100.     vec1, vec2                : vector;
  101.     p_vec                     : parametervector;
  102.  
  103. BEGIN
  104.   writeln;  WRITELN('Erster Datenvector : ');  readvector(vec1);
  105.   writeln;  WRITELN('Zweiter Datenvector :');  readvector(vec2);
  106.   signifikanz(alpha);
  107.   rxy := pearson(vec1, vec2);
  108.   dummy := quantil(sta,p_vec,1.0-alpha/2.0)/SQRT(vec1.n-3.0);
  109.   cu := z_trans(rxy,FALSE) + rxy/(2.0*(vec1.n-1.0)) - dummy;
  110.   co := z_trans(rxy,FALSE) + rxy/(2.0*(vec1.n-1.0)) + dummy;
  111.   cu := z_trans(cu, TRUE);
  112.   co := z_trans(co, TRUE);
  113.   konfidenz(rxy, cu, co);
  114.   warten;
  115. END;
  116. {---------------------------------------------------------------------------}
  117. PROCEDURE part_corr;
  118.  
  119. VAR rxy, rux, ruy, test, alpha, h0, co, dummy : REAL;
  120.     vec1, vec2, vec3                          : vector;
  121.     p                                         : parametervector;
  122.     seiten                                    : INTEGER;
  123.     tcu, tco                                  : BOOLEAN;
  124.  
  125. BEGIN
  126.   writeln;  WRITELN('Erster Datenvector :');  readvector(vec1);
  127.   writeln;  WRITELN('Zweiter Datenvector : ');  readvector(vec2);
  128.   writeln;  WRITELN('Dritter Datenvector : ');  readvector(vec3);
  129.   rxy := pearson(vec1, vec2);
  130.   rux := pearson(vec1, vec3);
  131.   ruy := pearson(vec2, vec3);
  132.   signifikanz(alpha);
  133.   nullhypothese(h0);
  134.   seiten := 1;  tcu := FALSE;  tco := TRUE;
  135.   dummy := (rxy-rux*ruy)/SQRT((1.0-rux*rux)*(1.0-ruy*ruy));
  136.   test := ABS(dummy*SQRT(vec1.n-3.0)/(1.0-dummy*dummy));
  137.   p[1] := vec1.n-3.0;
  138.   co := quantil(stu, p, 1.0-alpha/2.0);
  139.   entscheidung(test, alpha, h0, dummy, co, seiten, tcu, tco);
  140.   warten;
  141. END;
  142. {---------------------------------------------------------------------------}
  143. {                    Test auf Nicht-Korrelation h0:=0                       }
  144. PROCEDURE bicorr;
  145.  
  146. VAR  rxy, rxu, rxv, ryu,
  147.      ryv, ruv, test, alpha,
  148.      co, h0, dummy, dummy1,
  149.      dummy2                 : REAL;
  150.      p                      : parametervector;
  151.      vec1, vec2, vec3, vec4 : vector;
  152.      seiten                 : INTEGER ;
  153.      tcu, tco               : BOOLEAN;
  154.  
  155. BEGIN
  156.   writeln;  WRITELN('Erster Datenvector :');  readvector(vec1);
  157.   writeln;  WRITELN('Zweiter Datenvector :');  readvector(vec2);
  158.   writeln;  WRITELN('Dritter Datenvector : ');  readvector(vec3);
  159.   writeln;  WRITELN('Vierter Datenvector : ');  readvector(vec4);
  160.   signifikanz(alpha);
  161.   nullhypothese(h0);
  162.   seiten := 1;  tcu := FALSE;  tco := TRUE;
  163.   rxy := pearson(vec1, vec2);  rxu := pearson(vec1, vec3);
  164.   rxv := pearson(vec1, vec4);  ryu := pearson(vec2, vec3);
  165.   ryv := pearson(vec2, vec4);  ruv := pearson(vec3, vec4);
  166.   dummy1 := rxy - rxu*ryu - rxv*ryv + rxu*ryv*ruv;
  167.   dummy2 := SQRT((1.0-rxu*rxu)*(1.0-ryv*ryv));
  168.   dummy1 := dummy1/dummy2;
  169.   test := ABS(dummy1*SQRT((vec1.n-3.0)/(1.0-dummy1*dummy1)));
  170.   p[1] := vec1.n-3.0;
  171.   co := quantil(stu, p, 1.0-alpha/2.0);
  172.   entscheidung(test, alpha, h0, dummy, co, seiten, tcu, tco);
  173.   warten;
  174. END;
  175. {---------------------------------------------------------------------------}
  176. {                             Ende CORREL.INC                               }
  177.