home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l042 / 1.ddi / CHAP7.ARC / WIELANDT.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1987-12-30  |  8.8 KB  |  276 lines
  1. program Wielandt_Prog;
  2.  
  3. {----------------------------------------------------------------------------}
  4. {-                                                                          -}
  5. {-     Turbo Pascal Numerical Methods Toolbox                               -}
  6. {-     Copyright (c) 1986, 87 by Borland International, Inc.                -}
  7. {-                                                                          -}
  8. {-       Purpose : To demonstrate procedure Wielandt for approximating      -}
  9. {-                 some (or all) of the eigenvalues and eigenvectors of     -}
  10. {-                 of a matrix.                                             -}
  11. {-                                                                          -}
  12. {-       Unit    : EigenVal    procedure Wielandt                           -}
  13. {-                                                                          -}
  14. {----------------------------------------------------------------------------}
  15.  
  16. {$R+}    { Enable range checking }
  17. {$I-}    { Disable I/O checking }
  18. {$M 45056, 0, 655360} { Set MinStack:MinHeap:MaxHeap }
  19.  
  20. uses
  21.   EigenVal, Dos, Crt, Common;
  22.  
  23. var
  24.   Dimen : integer;          { Size of the square matrix }
  25.   Mat : TNmatrix;           { The matrix }
  26.   MaxEigens : integer;      { Maximum number eigens calculated }
  27.   MaxIter : integer;        { Maximum number iterations allowed }
  28.   Tolerance : Float;        { Tolerance }
  29.   GuessVector : TNvector;   { Initial approximation of the eigenvector }
  30.   NumEigens : integer;      { Number of eigenvalues found }
  31.   Eigenvectors : TNmatrix;  { Eigenvectors of the matrix }
  32.   Eigenvalues : TNvector;   { Associated eigenvalues }
  33.   Iter : TNIntVector;       { Number of iterations }
  34.   Error : byte;             { Flags if something went wrong }
  35.  
  36. procedure GetData(var Dimen       : integer;
  37.                   var Mat         : TNmatrix;
  38.                   var Tolerance   : Float;
  39.                   var MaxEigens   : integer;
  40.                   var MaxIter     : integer;
  41.                   var GuessVector : TNvector);
  42.  
  43. {------------------------------------------------------------------}
  44. {- Output: Dimen, Mat, Tolerance, MaxEigens, MaxIter, GuessVector -}
  45. {-                                                                -}
  46. {- This procedure reads in the data.  The dimension, the matrix,  -}
  47. {- Mat, and the initial guess, GuessVector, can be read in from   -}
  48. {- either a file or the keyboard.  The Tolerance, MaxEigens, and  -}
  49. {- MaxIter are read in from the keyboard.                         -}
  50. {------------------------------------------------------------------}
  51.  
  52. var
  53.   Ch : char;
  54.  
  55. procedure GetDataFromKeyboard(var Dimen       : integer;
  56.                               var Mat         : TNmatrix;
  57.                               var GuessVector : TNvector);
  58.  
  59. {-------------------------------------}
  60. {- Output: Dimen, Mat, GuessVector   -}
  61. {-                                   -}
  62. {- This procedure reads in the above -}
  63. {- variables from the keyboard.      -}
  64. {-------------------------------------}
  65.  
  66. var
  67.   Row, Column : integer;
  68.  
  69. begin
  70.   Writeln;
  71.   repeat
  72.     Write('Dimension of the matrix (1-', TNArraySize, ')? ');
  73.     Readln(Dimen);
  74.     IOCheck;
  75.   until (not IOerr) and (Dimen >= 1) and (Dimen <= TNArraySize);
  76.   Writeln;
  77.   for Row := 1 to Dimen do
  78.     for Column := 1 to Dimen do
  79.       repeat
  80.         Write('Matrix[', Row, ', ', Column, ']: ');
  81.         Readln(Mat[Row, Column]);
  82.         IOCheck;
  83.       until not IOerr;
  84.   Writeln;
  85.   Writeln('Now input an initial guess for the eigenvector:');
  86.   for Row := 1 to Dimen do
  87.   repeat
  88.     Write('Vector[', Row, ']: ');
  89.     Readln(GuessVector[Row]);
  90.     IOCheck;
  91.   until not IOerr;
  92. end; { procedure GetDataFromKeyboard }
  93.  
  94. procedure GetDataFromFile(var Dimen       : integer;
  95.                           var Mat         : TNmatrix;
  96.                           var GuessVector : TNvector);
  97.  
  98. {-------------------------------------}
  99. {- Output: Dimen, Mat, GuessVector   -}
  100. {-                                   -}
  101. {- This procedure reads in the above -}
  102. {- variables from the keyboard.      -}
  103. {-------------------------------------}
  104.  
  105. var
  106.   FileName : string[255];
  107.   InFile : text;
  108.   Row, Column : integer;
  109.  
  110. begin
  111.   Writeln;
  112.   repeat
  113.     Writeln;
  114.     repeat
  115.       Write('File name? ');
  116.       Readln(FileName);
  117.       Assign(InFile, FileName);
  118.       Reset(InFile);
  119.       IOCheck;
  120.     until not IOerr;
  121.     Read(InFile, Dimen);
  122.     IOCheck;
  123.     Row := 0;
  124.     while (not IOerr) and (Row < Dimen) do
  125.     begin
  126.       Row := Succ(Row);
  127.       Column := 0;
  128.       while (not IOerr) and (Column < Dimen) do
  129.       begin
  130.         Column := Succ(Column);
  131.         Read(InFile, Mat[Row, Column]);
  132.         IOCheck;
  133.       end;
  134.     end;
  135.     Row := 0;
  136.     while (not IOerr) and (Row < Dimen) do
  137.     begin
  138.       Row := Succ(Row);
  139.       Read(InFile, GuessVector[Row]);
  140.       IOCheck;
  141.     end;
  142.   until not IOerr;
  143.   Close(InFile);
  144. end; { procedure GetDataFromFile }
  145.  
  146. begin { procedure GetData }
  147.   Dimen := 0;
  148.   FillChar(Mat, SizeOf(Mat), 0);
  149.   FillChar(GuessVector, SizeOf(GuessVector), 0);
  150.   case InputChannel('Input Data From') of
  151.     'K' : GetDataFromKeyboard(Dimen, Mat, GuessVector);
  152.     'F' : GetDataFromFile(Dimen, Mat, GuessVector);
  153.   end;
  154.   Writeln;
  155.   Tolerance := 1E-6;
  156.   repeat
  157.     Write('Tolerance (> 0): ');
  158.     ReadFloat(Tolerance);
  159.     IOCheck;
  160.     if Tolerance <= 0 then
  161.     begin
  162.       IOerr := true;
  163.       Tolerance := 1E-6;
  164.     end;
  165.   until not IOerr;
  166.   Writeln;
  167.   MaxEigens := Dimen;
  168.   repeat
  169.     Write('Maximum number of eigenvalues/eigenvectors to find (<= ', Dimen, '): ');
  170.     ReadInt(MaxEigens);
  171.     IOCheck;
  172.     if (MaxEigens <= 0) or (MaxEigens > Dimen) then
  173.     begin
  174.       IOerr := true;
  175.       MaxEigens := Dimen
  176.     end;
  177.   until not IOerr;
  178.   Writeln;
  179.   MaxIter := 200;
  180.   repeat
  181.     Write('Maximum number of iterations (> 0): ');
  182.     ReadInt(MaxIter);
  183.     IOCheck;
  184.     if MaxIter <= 0 then
  185.     begin
  186.       IOerr := true;
  187.       MaxIter := 200;
  188.     end;
  189.   until not IOerr;
  190.   GetOutputFile(OutFile);
  191. end; { procedure GetData }
  192.  
  193. procedure Results(Dimen        : integer;
  194.               var Mat          : TNmatrix;
  195.                   Tolerance    : Float;
  196.                   MaxEigens    : integer;
  197.                   MaxIter      : integer;
  198.                   NumEigens    : integer;
  199.               var Eigenvectors : TNmatrix;
  200.               var Eigenvalues  : TNvector;
  201.                   Iter         : TNIntVector;
  202.                   Error        : byte);
  203.  
  204. {-----------------------}
  205. {- Output the results! -}
  206. {-----------------------}
  207.  
  208. var
  209.   Index, Column, Row : integer;
  210.  
  211. begin
  212.   Writeln(OutFile);
  213.   Writeln(OutFile);
  214.   Writeln(OutFile, 'The matrix: ');
  215.   for Row := 1 to Dimen do
  216.   begin
  217.     for Column := 1 to Dimen do
  218.       Write(OutFile, Mat[Row, Column]);
  219.     Writeln(OutFile);
  220.   end;
  221.   Writeln(OutFile);
  222.   Writeln(OutFile, 'Tolerance: ' : 30, Tolerance);
  223.   Writeln(OutFile, 'Maximum number of eigenvalues/eigenvectors to find: ' :
  224.                     30, MaxEigens);
  225.   Writeln(OutFile, 'Maximum number of iterations: ' : 30, MaxIter);
  226.   Writeln(OutFile);
  227.   if Error in [5, 6] then
  228.     DisplayWarning;
  229.   if Error in [1, 2, 3, 4] then
  230.     DisplayError;
  231.   case Error of
  232.     1 : Writeln(OutFile, 'The matrix must be of order greater than 1.');
  233.  
  234.     2 : Writeln(OutFile, 'The tolerance must be greater than zero.');
  235.  
  236.     3 : Writeln(OutFile,
  237.                 'Maximum number of iterations must be greater than zero.');
  238.  
  239.     4 : begin
  240.           Writeln(OutFile,
  241.                   'Maximum number of eigenvalues must be greater than zero');
  242.           Writeln(OutFile, 'and less than the dimension of the matrix.');
  243.         end;
  244.  
  245.     5 : begin
  246.           Writeln(OutFile, 'Convergence did not occur after ',
  247.                             Iter[NumEigens], ' iterations.');
  248.           Writeln(OutFile);
  249.           Writeln(OutFile, 'The results of the last iteration:');
  250.         end;
  251.  
  252.     6 : Writeln(OutFile, 'The last two eigenvalues aren''t real.');
  253.   end; { case }
  254.   if Error in [0, 5, 6] then
  255.   for Index := 1 to NumEigens do
  256.   begin
  257.     Writeln(OutFile);
  258.     Writeln(OutFile);
  259.     Writeln(OutFile, 'Number of iterations: ' : 30, Iter[Index] : 3);
  260.     Writeln(OutFile, ' The approximate eigenvector:');
  261.     for Row := 1 to Dimen do
  262.       Writeln(OutFile, Eigenvectors[Index, Row]);
  263.     Writeln(OutFile);
  264.     Writeln(OutFile, 'The associated eigenvalue: ' : 30, Eigenvalues[Index]);
  265.   end;
  266. end; { procedure Results }
  267.  
  268. begin  { program Wielandt }
  269.   ClrScr;
  270.   GetData(Dimen, Mat, Tolerance, MaxEigens, MaxIter, GuessVector);
  271.   Wielandt(Dimen, Mat, GuessVector, MaxEigens, MaxIter, Tolerance, NumEigens,
  272.            Eigenvalues, Eigenvectors, Iter, Error);
  273.   Results(Dimen, Mat, Tolerance, MaxEigens, MaxIter, NumEigens,
  274.           Eigenvectors, Eigenvalues, Iter, Error);
  275.   Close(OutFile);
  276. end. { program Wielandt }