home *** CD-ROM | disk | FTP | other *** search
- {***************************************************************************}
- {* CORREL.INC *}
- {* Routinen fuer Korrelationstests *}
- {***************************************************************************}
- FUNCTION covariance (vec1, vec2 : vector) : REAL;
-
- VAR i : INTEGER;
- xmw, ymw, dummy : REAL;
-
- BEGIN
- IF vec1.n = vec2.n THEN
- BEGIN
- mittel(vec1, xmw, dummy, dummy);
- mittel(vec2, ymw, dummy, dummy);
- dummy := 0;
- FOR I := 1 TO vec1.n DO dummy := dummy + vec1.value[I]*vec2.value[I];
- covariance := (dummy - vec1.n*xmw*ymw);
- END
- ELSE covariance := 0;
- END;
- {---------------------------------------------------------------------------}
- FUNCTION pearson (xvec, yvec : vector) : REAL;
-
- VAR xsum1, xsum2, ysum1, ysum2, dummy, dummy2, help1, help2 : REAL;
- I : INTEGER;
-
- BEGIN
- dummy := 0.0; xsum1 := 0.0; xsum2 := 0.0; ysum1 := 0.0; ysum2 := 0.0;
- FOR I := 1 TO xvec.n DO
- BEGIN
- dummy := dummy + xvec.value[I] * yvec.value[I];
- xsum1 := xsum1 + xvec.value[I];
- xsum2 := xsum2 + xvec.value[I] * xvec.value[I];
- ysum1 := ysum1 + yvec.value[I];
- ysum2 := ysum2 + yvec.value[I] * yvec.value[I];
- END;
- help1 := xsum1*xsum1/xvec.n; help2 := ysum1*ysum1/yvec.n;
- dummy2 := (xsum2 - help1)*(ysum2 - help2);
- IF dummy2 > 0.0 THEN pearson := (dummy - xsum1*ysum1/xvec.n)/SQRT(dummy2)
- ELSE WRITEln ('Produkt der Varianzen ist Null ! ');
- END;
- {---------------------------------------------------------------------------}
- { errechnet Korrelationsmatrizen für mehr als zwei Vektoren, also Matrizen }
- PROCEDURE corr_matrix (xmat,ymat : datenmatrix; VAR corrmat : matrix);
-
- VAR i,j : INTEGER;
-
- BEGIN
- corrmat.z := xmat.z; corrmat.s := ymat.z;
- FOR I := 1 TO xmat.z DO
- FOR J := 1 TO ymat.z DO
- corrmat.ele[I,J] := pearson(xmat.zeile[I], ymat.zeile[J]);
- END;
- {---------------------------------------------------------------------------}
- { Utility für Korrelationsberechnungen s. Literatur }
- { inv = false ===> Normalisierung: z :=arctanh(rxy) }
- { inv = true ===> Ruecktransformierung }
- FUNCTION z_trans (rxy : REAL; inv : BOOLEAN) : REAL;
-
- BEGIN
- IF inv THEN z_trans := (EXP(2.0*rxy)-1.0)/(EXP(2.0*rxy)+1.0)
- ELSE IF (1.0-ABS(rxy)) > 0.0 THEN z_trans := LN((1.0+rxy)/(1.0-rxy))/2.0;
- END;
- {---------------------------------------------------------------------------}
- PROCEDURE corrtest;
-
- VAR test, alpha, h0, rxy, co, dummy : REAL;
- vec1, vec2 : vector;
- tcu, tco : BOOLEAN;
- seiten : INTEGER;
- p : parametervector;
-
- BEGIN
- writeln; WRITELN('Erster Datenvector :'); readvector(vec1);
- writeln; WRITELN('Zweiter Datenvector :'); readvector(vec2);
- signifikanz(alpha);
- nullhypothese(h0);
- rxy := pearson(vec1, vec2);
- seiten := 1; tco := TRUE; tcu := FALSE;
- IF (1.0-ABS(rxy) > 0.0) AND (vec1.n > 3.0) THEN
- IF h0 <> 0.0 THEN
- BEGIN
- test := z_trans(rxy,FALSE)-z_trans(h0,FALSE)-h0/(2.0*(vec1.n-1.0));
- test := ABS(test*SQRT(vec1.n-3.0));
- co := quantil(sta, p, 1.0-alpha);
- END
- ELSE
- BEGIN
- test := rxy*SQRT(vec1.n-2.0)/SQRT(1.0-rxy*rxy);
- p[1] := vec1.n-2.0;
- co := quantil(stu, p, 1.0-alpha);
- END;
- entscheidung(test, alpha, h0, dummy, co, seiten, tcu, tco);
- warten;
- END;
- {---------------------------------------------------------------------------}
- PROCEDURE corrkonfidenz;
-
- VAR cu, co, alpha, rxy, dummy : REAL;
- vec1, vec2 : vector;
- p_vec : parametervector;
-
- BEGIN
- writeln; WRITELN('Erster Datenvector : '); readvector(vec1);
- writeln; WRITELN('Zweiter Datenvector :'); readvector(vec2);
- signifikanz(alpha);
- rxy := pearson(vec1, vec2);
- dummy := quantil(sta,p_vec,1.0-alpha/2.0)/SQRT(vec1.n-3.0);
- cu := z_trans(rxy,FALSE) + rxy/(2.0*(vec1.n-1.0)) - dummy;
- co := z_trans(rxy,FALSE) + rxy/(2.0*(vec1.n-1.0)) + dummy;
- cu := z_trans(cu, TRUE);
- co := z_trans(co, TRUE);
- konfidenz(rxy, cu, co);
- warten;
- END;
- {---------------------------------------------------------------------------}
- PROCEDURE part_corr;
-
- VAR rxy, rux, ruy, test, alpha, h0, co, dummy : REAL;
- vec1, vec2, vec3 : vector;
- p : parametervector;
- seiten : INTEGER;
- tcu, tco : BOOLEAN;
-
- BEGIN
- writeln; WRITELN('Erster Datenvector :'); readvector(vec1);
- writeln; WRITELN('Zweiter Datenvector : '); readvector(vec2);
- writeln; WRITELN('Dritter Datenvector : '); readvector(vec3);
- rxy := pearson(vec1, vec2);
- rux := pearson(vec1, vec3);
- ruy := pearson(vec2, vec3);
- signifikanz(alpha);
- nullhypothese(h0);
- seiten := 1; tcu := FALSE; tco := TRUE;
- dummy := (rxy-rux*ruy)/SQRT((1.0-rux*rux)*(1.0-ruy*ruy));
- test := ABS(dummy*SQRT(vec1.n-3.0)/(1.0-dummy*dummy));
- p[1] := vec1.n-3.0;
- co := quantil(stu, p, 1.0-alpha/2.0);
- entscheidung(test, alpha, h0, dummy, co, seiten, tcu, tco);
- warten;
- END;
- {---------------------------------------------------------------------------}
- { Test auf Nicht-Korrelation h0:=0 }
- PROCEDURE bicorr;
-
- VAR rxy, rxu, rxv, ryu,
- ryv, ruv, test, alpha,
- co, h0, dummy, dummy1,
- dummy2 : REAL;
- p : parametervector;
- vec1, vec2, vec3, vec4 : vector;
- seiten : INTEGER ;
- tcu, tco : BOOLEAN;
-
- BEGIN
- writeln; WRITELN('Erster Datenvector :'); readvector(vec1);
- writeln; WRITELN('Zweiter Datenvector :'); readvector(vec2);
- writeln; WRITELN('Dritter Datenvector : '); readvector(vec3);
- writeln; WRITELN('Vierter Datenvector : '); readvector(vec4);
- signifikanz(alpha);
- nullhypothese(h0);
- seiten := 1; tcu := FALSE; tco := TRUE;
- rxy := pearson(vec1, vec2); rxu := pearson(vec1, vec3);
- rxv := pearson(vec1, vec4); ryu := pearson(vec2, vec3);
- ryv := pearson(vec2, vec4); ruv := pearson(vec3, vec4);
- dummy1 := rxy - rxu*ryu - rxv*ryv + rxu*ryv*ruv;
- dummy2 := SQRT((1.0-rxu*rxu)*(1.0-ryv*ryv));
- dummy1 := dummy1/dummy2;
- test := ABS(dummy1*SQRT((vec1.n-3.0)/(1.0-dummy1*dummy1)));
- p[1] := vec1.n-3.0;
- co := quantil(stu, p, 1.0-alpha/2.0);
- entscheidung(test, alpha, h0, dummy, co, seiten, tcu, tco);
- warten;
- END;
- {---------------------------------------------------------------------------}
- { Ende CORREL.INC }