home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l042 / 1.ddi / CHAP2.ARC / RAPHSON.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-12-30  |  6.7 KB  |  200 lines
  1. program Newton_Raphson_Prog;
  2.  
  3. {----------------------------------------------------------------------------}
  4. {-                                                                          -}
  5. {-     Turbo Pascal Numerical Methods Toolbox                               -}
  6. {-     Copyright (c) 1986, 87 by Borland International, Inc.                -}
  7. {-                                                                          -}
  8. {-            Purpose: This sample program demonstrates the                 -}
  9. {-                     Newton-Raphson algorithm.                            -}
  10. {-                                                                          -}
  11. {-            Unit   : RootsEqu    procedure Newton_Raphson                 -}
  12. {-                                                                          -}
  13. {----------------------------------------------------------------------------}
  14.  
  15. {$I-}                          { Disable I/O error trapping }
  16. {$R+}                          { Enable range checking }
  17.  
  18. uses
  19.   RootsEqu, Dos, Crt, Common;
  20.  
  21. var
  22.   InitGuess : Float;           { Initial approximation }
  23.   Tolerance : Float;           { Tolerance in answer }
  24.   Root, Value, Deriv : Float;  { Resulting roots and other info }
  25.   Iter : integer;              { Number of iterations to find root }
  26.   MaxIter : integer;           { Maximum number of iterations }
  27.   Error : byte;                { Error flag }
  28.  
  29. {$F+}
  30. {------- HERE IS THE FUNCTION ----------}
  31. function TNTargetF(X : Float) : Float;
  32. begin
  33.   TNTargetF := Cos(X) - X;
  34. end;  { function TNTargetF }
  35. {---------------------------------------}
  36.  
  37. {------- HERE IS THE DERIVATIVE --------}
  38. function TNDerivF(X : Float) : Float;
  39. begin
  40.   TNDerivF := -Sin(X) - 1;
  41. end; { function TNDerivF }
  42. {---------------------------------------}
  43. {$F-}
  44.  
  45. procedure Initialize(var InitGuess : Float;
  46.                      var Tolerance : Float;
  47.                      var Root      : Float;
  48.                      var Value     : Float;
  49.                      var Deriv     : Float;
  50.                      var MaxIter   : integer;
  51.                      var Iter      : integer;
  52.                      var Error     : byte);
  53.  
  54. {-----------------------------------------------------------}
  55. {- Output: InitGuess, Tolerance, Root, Value, Deriv,       -}
  56. {-         MaxIter, Iter, Error                            -}
  57. {-                                                         -}
  58. {- This procedure initializes the above variables to zero. -}
  59. {-----------------------------------------------------------}
  60.  
  61. begin
  62.   InitGuess := 0;
  63.   Tolerance := 0;
  64.   MaxIter := 0;
  65.   Root := 0;
  66.   Value := 0;
  67.   Deriv := 0;
  68.   Error := 0;
  69.   Iter := 0;
  70. end; { procedure Initialize }
  71.  
  72. procedure UserInput(var InitGuess : Float;
  73.                     var Tol       : Float;
  74.                     var MaxIter   : integer);
  75.  
  76. {-------------------------------------------------------------}
  77. {- Output: InitGuess, Tol, MaxIter                           -}
  78. {-                                                           -}
  79. {- This procedure assigns values to the initial guess        -}
  80. {- (InitGuess), to the tolerance with which the answer       -}
  81. {- should be found, and to the maximum number of iterations  -}
  82. {- to be performed. Input is from the keyboard.              -}
  83. {-------------------------------------------------------------}
  84.  
  85. procedure GetInitialGuess(var InitGuess : Float);
  86. begin
  87.   repeat
  88.     Writeln;
  89.     Write('Initial approximation to the root: ');
  90.     Readln(InitGuess);
  91.     IOCheck;        { Check for I/O errors }
  92.   until not IOerr;
  93. end; { procedure GetInitialGuess }
  94.  
  95. procedure GetTolerance(var Tol : Float);
  96. begin
  97.   Tol := 1E-8;
  98.   repeat
  99.     Writeln;
  100.     Write('Tolerance (> 0): ');
  101.     ReadFloat(Tol);
  102.     IOCheck;        { Check for I/O errors }
  103.     if Tol <= 0 then
  104.     begin
  105.       IOerr := true;
  106.       Tol := 1E-8;
  107.     end;
  108.   until not IOerr;
  109. end; { procedure GetTolerance }
  110.  
  111. procedure GetMaxIter(var MaxIter : integer);
  112. begin
  113.   MaxIter := 100;
  114.   repeat
  115.     Writeln;
  116.     Write('Maximum number of iterations (> 0): ');
  117.     ReadInt(MaxIter);
  118.     IOCheck;        { Check for I/O errors }
  119.     if MaxIter < 0 then
  120.     begin
  121.       IOerr := true;
  122.       MaxIter := 100;
  123.     end;
  124.   until not IOerr;
  125. end; { procedure GetMaxIter }
  126.  
  127. begin { procedure UserInput }
  128.   GetInitialGuess(InitGuess);
  129.   GetTolerance(Tol);
  130.   GetMaxIter(MaxIter);
  131.   GetOutputFile(OutFile);
  132. end; { procedure UserInput }
  133.  
  134. procedure Results(InitGuess : Float;
  135.                   Tol       : Float;
  136.                   MaxIter   : integer;
  137.               var OutFile   : text;
  138.                   Root      : Float;
  139.                   Value     : Float;
  140.                   Deriv     : Float;
  141.                   Iter      : integer;
  142.                   Error     : byte);
  143.  
  144. {------------------------------------------------------------}
  145. {- This procedure outputs the results to the device OutFile -}
  146. {------------------------------------------------------------}
  147.  
  148. begin
  149.   Writeln(OutFile);
  150.   Writeln(OutFile);
  151.   Writeln(OutFile, 'Initial approximation: ' : 30, InitGuess);
  152.   Writeln(OutFile, 'Tolerance: ' : 30, Tol);
  153.   Writeln(OutFile, 'Maximum number of iterations: ' : 30, MaxIter);
  154.   Writeln(OutFile);
  155.   if Error in [1, 2] then
  156.     DisplayWarning;
  157.   if Error >= 3 then
  158.     DisplayError;
  159.  
  160.   case Error of
  161.     1 : begin
  162.           Write(OutFile, 'It will take more than ',MaxIter,
  163.                          ' iterations to solve this equation');
  164.         end;
  165.  
  166.     2 : Writeln(OutFile,'The slope is approaching zero.');
  167.  
  168.     3 : Writeln(OutFile, 'The tolerance must be greater than zero!');
  169.  
  170.     4 : Writeln(OutFile,
  171.                 'The maximum number of iteration must be greater than zero!');
  172.  
  173.   end; { case }
  174.  
  175.   if Error <= 2 then
  176.   begin
  177.     Writeln(OutFile);
  178.     Writeln(OutFile, 'Number of iterations: ' : 26, Iter : 3);
  179.     Writeln(OutFile, 'Calculated root: ' : 26, Root);
  180.     Writeln(OutFile, 'Value of the function  ' : 26);
  181.     Writeln(OutFile, 'at the calculated root: ' : 26, Value);
  182.     Writeln(OutFile, 'Value of the derivative  ' : 26);
  183.     Writeln(OutFile, 'of the function at the  ' : 26);
  184.     Writeln(OutFile, 'calculated root: ' : 26, Deriv);
  185.     Writeln(OutFile);
  186.   end;
  187. end; { procedure Results }
  188.  
  189. begin { program Newton_Raphson }
  190.   ClrScr;
  191.   Initialize(InitGuess, Tolerance, Root, Value, Deriv, MaxIter, Iter, Error);
  192.   UserInput(InitGuess, Tolerance, MaxIter);
  193.   { Use the Newton-Raphson method to converge onto a root }
  194.   Newton_Raphson(InitGuess, Tolerance, MaxIter,
  195.                  Root, Value, Deriv, Iter, Error, @TNTargetF, @TNDerivF);
  196.   Results(InitGuess, Tolerance, MaxIter, OutFile,
  197.           Root, Value, Deriv, Iter, Error);
  198.   Close(OutFile);         { Close output file }
  199. end. { program Newton_Raphson }
  200.