tqli.dem

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

PROGRAM d11r4(input,output);
(* driver for routine TQLI *)
CONST
   np=10;
   tiny=1.0e-6;
TYPE
   glnp = ARRAY [1..np] OF real;
   glnpnp = ARRAY [1..np,1..np] OF real;
VAR
   i,j,k : integer;
   a,c : glnpnp;
   d,e,f : glnp;

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

(*$I TQLI.PAS *)

BEGIN
   c[1,1] := 5.0; c[1,2] := 4.0; c[1,3] := 3.0;
   c[1,4] := 2.0; c[1,5] := 1.0; c[1,6] := 0.0;
   c[1,7] := -1.0; c[1,8] := -2.0; c[1,9] := -3.0;
   c[1,10] := -4.0;
   c[2,1] := 4.0; c[2,2] := 5.0; c[2,3] := 4.0;
   c[2,4] := 3.0; c[2,5] := 2.0; c[2,6] := 1.0;
   c[2,7] := 0.0; c[2,8] := -1.0; c[2,9] := -2.0;
   c[2,10] := -3.0;
   c[3,1] := 3.0; c[3,2] := 4.0; c[3,3] := 5.0;
   c[3,4] := 4.0; c[3,5] := 3.0; c[3,6] := 2.0;
   c[3,7] := 1.0; c[3,8] := 0.0; c[3,9] := -1.0;
   c[3,10] := -2.0;
   c[4,1] := 2.0; c[4,2] := 3.0; c[4,3] := 4.0;
   c[4,4] := 5.0; c[4,5] := 4.0; c[4,6] := 3.0;
   c[4,7] := 2.0; c[4,8] := 1.0; c[4,9] := 0.0;
   c[4,10] := -1.0;
   c[5,1] := 1.0; c[5,2] := 2.0; c[5,3] := 3.0;
   c[5,4] := 4.0; c[5,5] := 5.0; c[5,6] := 4.0;
   c[5,7] := 3.0; c[5,8] := 2.0; c[5,9] := 1.0;
   c[5,10] := 0.0;
   c[6,1] := 0.0; c[6,2] := 1.0; c[6,3] := 2.0;
   c[6,4] := 3.0; c[6,5] := 4.0; c[6,6] := 5.0;
   c[6,7] := 4.0; c[6,8] := 3.0; c[6,9] := 2.0;
   c[6,10] := 1.0;
   c[7,1] := -1.0; c[7,2] := 0.0; c[7,3] := 1.0;
   c[7,4] := 2.0; c[7,5] := 3.0; c[7,6] := 4.0;
   c[7,7] := 5.0; c[7,8] := 4.0; c[7,9] := 3.0;
   c[7,10] := 2.0;
   c[8,1] := -2.0; c[8,2] := -1.0; c[8,3] := 0.0;
   c[8,4] := 1.0; c[8,5] := 2.0; c[8,6] := 3.0;
   c[8,7] := 4.0; c[8,8] := 5.0; c[8,9] := 4.0;
   c[8,10] := 3.0;
   c[9,1] := -3.0; c[9,2] := -2.0; c[9,3] := -1.0;
   c[9,4] := 0.0; c[9,5] := 1.0; c[9,6] := 2.0;
   c[9,7] := 3.0; c[9,8] := 4.0; c[9,9] := 5.0;
   c[9,10] := 4.0;
   c[10,1] := -4.0; c[10,2] := -3.0; c[10,3] := -2.0;
   c[10,4] := -1.0; c[10,5] := 0.0; c[10,6] := 1.0;
   c[10,7] := 2.0; c[10,8] := 3.0; c[10,9] := 4.0;
   c[10,10] := 5.0;
   FOR i := 1 to np DO BEGIN
      FOR j := 1 to np DO BEGIN
         a[i,j] := c[i,j]
      END
   END;
   tred2(a,np,d,e);
   tqli(d,e,np,a);
   writeln('eigenvectors for a real symmetric matrix');
   FOR i := 1 to np DO BEGIN
      FOR j := 1 to np DO BEGIN
         f[j] := 0.0;
         FOR k := 1 to np DO BEGIN
            f[j] := f[j]+c[j,k]*a[k,i]
         END
      END;
      writeln('eigenvalue',i:3,'  := ',d[i]:10:6);
      writeln('vector':11,'mtrx*vect.':14,'ratio':9);
      FOR j := 1 to np DO BEGIN
         IF (abs(a[j,i]) < tiny) THEN BEGIN
            writeln(a[j,i]:12:6,f[j]:12:6,'div. by 0':12)
         END ELSE BEGIN
            writeln(a[j,i]:12:6,f[j]:12:6,f[j]/a[j,i]:12:6)
         END
      END;
   writeln('press enter to continue...');
   readln
   END
END.