home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 8 / CDASC08.ISO / NEWS / 554 / JUILLET / PYTHAG.PAS < prev    next >
Pascal/Delphi Source File  |  1993-10-07  |  3KB  |  78 lines
  1. {─ Fido Pascal Conference ────────────────────────────────────────────── PASCAL ─
  2. Msg  : 336 of 353                                                               
  3. From : Brian McCormick                     1:3821/1.0           24 Jul 93  09:58 
  4. To   : Gary Morris                                                               
  5. Subj : Fermat's Theorem 2/2                                                   
  6. ────────────────────────────────────────────────────────────────────────────────
  7. This program generates triples satisfying x**2 + y**2 = z**2 using a method
  8. that eliminates floating point calculations and most multiplications.  It can
  9. be fairly easily adjusted to accomodate cubes or higher order powers.  If
  10. anyone has any suggestions or improvements to this algorithm, let me know.  It 
  11. runs in O(n**2) time, just like the brute force method involving a pair of
  12. nested loops, however, it eliminates all floating point calculations and checks
  13. fewer values and is thus dramatically faster.
  14.  
  15. Triples generated by this program are sorted by Z, not by X or Y as they are
  16. using the obvious algorithm.}
  17.  
  18. program pythag;
  19.  
  20. { The display can be made faster by adding the line }
  21. {  uses crt;                                        }
  22. { here.                                             }
  23.  
  24. const MAXINLIST = 1200;
  25.  
  26. type p_squarelist = ^t_squarelist;
  27.      t_squarelist = array[1..MAXINLIST] of longint;
  28.  
  29. var out     : text;
  30.     a, b, c : longint;
  31.     sl1     : p_squarelist;
  32.  
  33. procedure writetriple( a, b, c: longint );
  34.    begin
  35.       writeln( a:7, b:7, c:7 );
  36.    end;
  37.  
  38. procedure checkforpyth( c: word );
  39.    var a, b    : word;
  40.        check   : longint;
  41.        sum     : longint;
  42.    begin
  43.       a := 1;
  44.       b := c-1;
  45.       check := sl1^[c];
  46.       while a < b do begin
  47.          sum := sl1^[a] + sl1^[b];
  48.          if sum = check then begin
  49.             writetriple( a, b, c );
  50.             inc(a);
  51.             end
  52.          else if sum > check then
  53.             dec(b)
  54.          else
  55.             inc(a);
  56.          end;
  57.    end;
  58.  
  59. procedure initsquarelist( var sl: p_squarelist; start: integer );
  60.    var loop: integer;
  61.        stop: integer;
  62.    begin
  63.       new( sl );
  64.       if start + MAXINLIST - 1 < 0 then
  65.          stop := maxint
  66.       else
  67.          stop := start + MAXINLIST - 1;
  68.       for loop := start to stop do
  69.          sl^[loop-start+1] := longint(loop)*loop;
  70.    end;
  71.  
  72. begin
  73.    writeln( 'Generating list of squares' );
  74.    initsquarelist( sl1, 1 );
  75.    for a := 3 to MAXINLIST do
  76.       checkforpyth( a );
  77.    writeln;
  78. end.