covsrt.dem

Delphi Pascal 数据挖掘领域算法包 数值算法大全

PROGRAM d14r3(input,output);
(* driver for routine COVSRT *)
CONST
   ma=10;
   mfit=5;
TYPE
   glcovar = ARRAY [1..ma,1..ma] OF real;
   gllista = ARRAY [1..mfit] OF integer;
VAR
   i,j : integer;
   covar : glcovar;
   lista : gllista;

(*$I MODFILE.PAS *)
(*$I COVSRT.PAS *)

BEGIN
   FOR i := 1 to ma DO BEGIN
      FOR j := 1 to ma DO BEGIN
         covar[i,j] := 0.0;
         IF ((i <= 5) AND (j <= 5)) THEN BEGIN
            covar[i,j] := i+j-1
         END
      END
   END;
   writeln;
   writeln('original matrix');
   FOR i := 1 to ma DO BEGIN
      FOR j := 1 to ma DO write(covar[i,j]:4:1);
      writeln
   END;
   writeln(' press RETURN to continue...');
   readln;
(* test 1 - spread by 2 *)
   writeln;
   writeln('test #1 - spread by two');
   FOR i := 1 to mfit DO BEGIN
      lista[i] := 2*i
   END;
   covsrt(covar,ma,ma,lista,mfit);
   FOR i := 1 to ma DO BEGIN
      FOR j := 1 to ma DO write(covar[i,j]:4:1);
      writeln
   END;
   writeln(' press RETURN to continue...');
   readln;
(* test 2 - reverse *)
   writeln;
   writeln('test #2 - reverse');
   FOR i := 1 to ma DO BEGIN
      FOR j := 1 to ma DO BEGIN
         covar[i,j] := 0.0;
         IF  ((i <= 5) AND (j <= 5)) THEN BEGIN
            covar[i,j] := i+j-1
         END
      END
   END;
   FOR i := 1 to mfit DO BEGIN
      lista[i] := mfit+1-i
   END;
   covsrt(covar,ma,ma,lista,mfit);
   FOR i := 1 to ma DO BEGIN
      FOR j := 1 to ma DO write(covar[i,j]:4:1);
      writeln
   END;
   writeln(' press RETURN to continue...');
   readln;
(* test 3 - spread and reverse *)
   writeln;
   writeln('test #3 - spread and reverse');
   FOR i := 1 to ma DO BEGIN
      FOR j := 1 to ma DO BEGIN
         covar[i,j] := 0.0;
         IF ((i <= 5) AND (j <= 5)) THEN BEGIN
            covar[i,j] := i+j-1
         END
      END
   END;
   FOR i := 1 to mfit DO BEGIN
      lista[i] := ma+2-2*i
   END;
   covsrt(covar,ma,ma,lista,mfit);
   FOR i := 1 to ma DO BEGIN
      FOR j := 1 to ma DO write(covar[i,j]:4:1);
      writeln
   END
END.