home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l042 / 1.ddi / CHAP3.ARC / DIVDIF.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-12-30  |  8.6 KB  |  257 lines
  1. program Divided_Difference_Prog;
  2.  
  3. {----------------------------------------------------------------------------}
  4. {-                                                                          -}
  5. {-     Turbo Pascal Numerical Methods Toolbox                               -}
  6. {-     Copyright (c) 1986, 87 by Borland International, Inc.                -}
  7. {-                                                                          -}
  8. {-           Purpose: This program demonstrates interpolation with Newton's -}
  9. {-                    general interpolatory divided difference equation.    -}
  10. {-                                                                          -}
  11. {-           Unit   : Interp    procedure Divided_Difference                -}
  12. {-                                                                          -}
  13. {----------------------------------------------------------------------------}
  14.  
  15. {$I-}                  { Disable I/O error trapping }
  16. {$R+}                  { Enable range checking }
  17. {$M 32000,0,655360}    { Memory allocation sizes }
  18.  
  19. uses
  20.   Interp, Dos, Crt, Common;
  21.  
  22. var
  23.   XData, YData : TNvector;          { Data points (X,Y) }
  24.   NumPoints : integer;              { Number of points }
  25.   NumInter : integer;               { Number of interpolated points }
  26.   XInter : TNvector;                { Values at which to interpolate }
  27.   YInter : TNvector;                { Interpolated values at XInterpolate }
  28.   Error : byte;                     { Flags if something went wrong }
  29.  
  30. procedure Initialize(var XData  : TNvector;
  31.                      var YData  : TNvector;
  32.                      var XInter : TNvector;
  33.                      var YInter : TNvector;
  34.                      var Error  : byte);
  35.  
  36. {----------------------------------------------------------}
  37. {- Output: XData, YData, XInter, YInter, Error            -}
  38. {-                                                        -}
  39. {- This procedure initializes the above variables to zero -}
  40. {----------------------------------------------------------}
  41.  
  42. begin
  43.   FillChar(XData, SizeOf(XData), 0);
  44.   FillChar(YData, SizeOf(XData), 0);
  45.   FillChar(XInter, SizeOf(XData), 0);
  46.   FillChar(YInter, SizeOf(XData), 0);
  47.   Error := 0;
  48. end; { procedure Initialize }
  49.  
  50. procedure GetData(var NumPoints : integer;
  51.                   var NumInter  : integer;
  52.                   var XData     : TNvector;
  53.                   var YData     : TNvector;
  54.                   var XInter    : TNvector);
  55.  
  56. {--------------------------------------------------------------}
  57. {- Output: NumPoints, NumInter, XData, YData, XInter          -}
  58. {-                                                            -}
  59. {- This procedure reads in data from either the keyboard      -}
  60. {- or a data file.  The number of data points (NumPoints),    -}
  61. {- the data points (XData, YData), the number of interpolated -}
  62. {- points (NumInter) and the X values at which to interpolate -}
  63. {- (XInter) are all read in here.                             -}
  64. {--------------------------------------------------------------}
  65.  
  66. var
  67.   Ch : char;
  68.  
  69. procedure GetTwoVectorsFromFile(var NumPoints : integer;
  70.                                 var XData     : TNvector;
  71.                                 var YData     : TNvector);
  72.  
  73. {-------------------------------------------------------------}
  74. {- Output: NumPoints, XData, YData                           -}
  75. {-                                                           -}
  76. {- This procedure reads in the data points from a data file. -}
  77. {-------------------------------------------------------------}
  78.  
  79. var
  80.   Filename : string[255];
  81.   InFile : text;
  82.  
  83. begin
  84.   Writeln;
  85.   repeat
  86.     Write('File name? ');
  87.     Readln(Filename);
  88.     Assign(InFile, Filename);
  89.     Reset(InFile);
  90.     IOCheck;
  91.   until not IOerr;
  92.   NumPoints:=0;
  93.   while not(EOF(InFile)) do
  94.   begin
  95.     NumPoints:=Succ(NumPoints);
  96.     Readln(InFile, XData[NumPoints], YData[NumPoints]);
  97.     IOCheck;
  98.   end;
  99.   Close(InFile);
  100. end; { procedure GetTwoVectorsFromFile }
  101.  
  102. procedure GetTwoVectorsFromKeyboard(var NumPoints : integer;
  103.                                     var XData     : TNvector;
  104.                                     var YData     : TNvector);
  105.  
  106. {--------------------------------------------------------------}
  107. {- Output: NumPoints, XData, YData                            -}
  108. {-                                                            -}
  109. {- This procedure reads in the data points from the keyboard. -}
  110. {--------------------------------------------------------------}
  111.  
  112. var
  113.   Term : integer;
  114.  
  115. begin
  116.   NumPoints:=0;
  117.   Writeln;
  118.   repeat
  119.     Write('Number of points (0-', TNArraySize, ')? ');
  120.     Readln(NumPoints);
  121.     IOCheck;
  122.   until ((NumPoints >= 0) and (NumPoints <= TNArraySize) and not IOerr);
  123.   Writeln;
  124.   Write('Type in the X ');
  125.   Writeln('and Y values, separated by a space (not a comma):');
  126.   for Term := 1 to NumPoints do
  127.     repeat
  128.       Write('X[', Term, '], Y[', Term, ']:');
  129.       Read(XData[Term], YData[Term]);
  130.       Writeln;
  131.       IOCheck;
  132.     until not IOerr;
  133. end; { procedure GetTwoVectorsFromKeyboard }
  134.  
  135. procedure GetOneVectorFromFile(var NumInter : integer;
  136.                                var XInter   : TNvector);
  137.  
  138. {------------------------------------------}
  139. {- Output: NumInter, XInter               -}
  140. {-                                        -}
  141. {- This procedure reads in the points at  -}
  142. {- which to interpolate from a data file. -}
  143. {------------------------------------------}
  144.  
  145. var
  146.   Filename : string[255];
  147.   InFile : text;
  148.  
  149. begin
  150.   Writeln;
  151.   repeat
  152.     Write('File name? ');
  153.     Readln(Filename);
  154.     Assign(InFile, Filename);
  155.     Reset(InFile);
  156.     IOCheck;
  157.   until not IOerr;
  158.   NumInter := 0;
  159.   while not(EOF(InFile)) do
  160.   begin
  161.     NumInter:=Succ(NumInter);
  162.     Readln(InFile, XInter[NumInter]);
  163.     IOCheck;
  164.   end;
  165.   Close(InFile);
  166. end; { procedure GetOneVectorFromFile }
  167.  
  168. procedure GetOneVectorFromKeyboard(var NumInter : integer;
  169.                                    var XInter   : TNvector);
  170.  
  171. {-------------------------------------------}
  172. {- Output: NumInter, XInter                -}
  173. {-                                         -}
  174. {- This procedure reads in the points at   -}
  175. {- which to interpolate from the keyboard. -}
  176. {-------------------------------------------}
  177.  
  178. var
  179.   Term : integer;
  180.  
  181. begin
  182.   NumInter := 0;
  183.   Writeln;
  184.   repeat
  185.     Write('Number of points (0-', TNArraySize, ')?');
  186.     Readln(NumInter);
  187.     IOCheck;
  188.   until((NumInter >= 0) and (NumInter <= TNArraySize) and not IOerr);
  189.   Writeln;
  190.   for Term:=1 to NumInter do
  191.   repeat
  192.     Write('Point ', Term, ': ');
  193.     Readln(XInter[Term]);
  194.     IOCheck;
  195.   until not IOerr;
  196. end; { procedure GetOneVectorFromKeyboard }
  197.  
  198. begin { procedure GetData }
  199.   case InputChannel('Input Data Points From') of
  200.     'K' : GetTwoVectorsFromKeyboard(NumPoints, XData, YData);
  201.     'F' : GetTwoVectorsFromFile(NumPoints, XData, YData);
  202.   end;
  203.   Writeln;
  204.   case InputChannel('Input Interpolated Points From') of
  205.     'K' : GetOneVectorFromKeyboard(NumInter, XInter);
  206.     'F' : GetOneVectorFromFile(NumInter, XInter);
  207.   end;
  208.   GetOutputFile(OutFile);
  209. end; { procedure GetData }
  210.  
  211. procedure Results(NumPoints : integer;
  212.               var XData     : TNvector;
  213.               var YData     : TNvector;
  214.                   NumInter  : integer;
  215.               var XInter    : TNvector;
  216.               var YInter    : TNvector);
  217.  
  218. {------------------------------------------------------------}
  219. {- This procedure outputs the results to the device OutFile -}
  220. {------------------------------------------------------------}
  221.  
  222. var
  223.   Index : integer;
  224.  
  225. begin
  226.   Writeln(OutFile);
  227.   Writeln(OutFile);
  228.   Writeln(OutFile, '     X                   Y');
  229.   for Index := 1 to NumPoints do
  230.     Writeln(OutFile, XData[Index] : 8 : 3, ' ' : 10, YData[Index] : 12 : 7);
  231.   Writeln(OutFile);
  232.   if Error >= 1 then
  233.     DisplayError;
  234.   case Error of
  235.     0 : begin
  236.           Writeln(OutFile, '     X              Interpolated Y value');
  237.           for Index := 1 to NumInter do
  238.             Writeln(OutFile, XInter[Index] : 8 : 3, ' ' : 10, YInter[Index]);
  239.         end;
  240.  
  241.     1 : Writeln(OutFile, 'The X data points must be unique.');
  242.  
  243.     2 : Writeln(OutFile, 'There must be at least one data point.');
  244.  
  245.   end; { case }
  246. end; { procedure Results }
  247.  
  248. begin { program Divided_difference }
  249.   ClrScr;
  250.   Initialize(XData, YData, XInter, YInter, Error);
  251.   GetData(NumPoints, NumInter, XData, YData, XInter);
  252.   Divided_Difference(NumPoints, XData, YData,
  253.                      NumInter, XInter, YInter, Error);
  254.   Results(NumPoints, XData, YData, NumInter, XInter, YInter);
  255.   Close(OutFile);
  256. end. { program Divided_difference }
  257.