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