Initial data commit

Task/Pythagorean-quadruples/Pascal/pythagorean-quadruples-1.pas

@@ -0,0 +1,69 @@
+program pythQuad;
+//find phythagorean Quadrupel up to a,b,c,d <= 2200
+//a^2 + b^2 +c^2 = d^2
+//find all values of d which are not possible
+//brute force
+//split in two procedure to reduce register pressure for CPU32
+
+const
+  MaxFactor =2200;
+  limit = MaxFactor*MaxFactor;
+type
+  tIdx = NativeUint;
+  tSum = NativeUint;
+
+var
+  check : array[0..MaxFactor] of boolean;
+  checkCnt : LongWord;
+
+procedure Find2(s:tSum;idx:tSum);
+//second sum (a*a+b*b) +c*c =?= d*d
+var
+  s1 : tSum;
+  d : tSum;
+begin
+  d := trunc(sqrt(s+idx*idx));// calculate first sqrt
+  For idx := idx to MaxFactor do
+  Begin
+    s1 := s+idx*idx;
+    If s1 <= limit then
+    Begin
+      while s1 > d*d do //adjust sqrt
+        inc(d);
+      inc(checkCnt);
+      IF s1=d*d then
+        check[d] := true;
+    end
+    else
+      Break;
+  end;
+end;
+
+procedure Find1;
+//first sum a*a+b*b
+var
+  a,b : tIdx;
+  s : tSum;
+begin
+  For a := 1 to MaxFactor do
+    For b := a to MaxFactor do
+    Begin
+      s := a*a+b*b;
+      if s < limit then
+        Find1(s,b)
+      else
+        break;
+     end;
+end;
+
+var
+  i : NativeUint;
+begin
+  Find1;
+
+  For i := 1 to MaxFactor do
+    If Not(Check[i]) then
+      write(i,' ');
+  writeln;
+  writeln(CheckCnt,' checks were done');
+end.

Task/Pythagorean-quadruples/Pascal/pythagorean-quadruples-2.pas

@@ -0,0 +1,70 @@
+program pythQuad_2;
+//find phythagorean Quadrupel up to a,b,c,d <= 2200
+//a^2 + b^2 +c^2 = d^2
+//a^2 + b^2 = d^2-c^2
+{$IFDEF FPC}
+  {$R+,O+} //debug purposes, not slower
+  {$OPTIMIZATION ON,ALL}
+  {$CODEALIGN proc=16}
+{$ELSE}
+   {$APPTYPE CONSOLE}
+{$ENDIF}
+uses
+   sysutils;
+const
+   MaxFactor = 2200;//22000;//40960;
+   limit = MaxFactor*MaxFactor;
+type
+   tIdx = NativeUint;
+   tSum = NativeUint;
+var
+// global variables are initiated with 0 at startUp
+   sumA2B2 :array[0..limit] of byte;
+   check :  array[0..MaxFactor] of byte;
+
+procedure BuildSumA2B2;
+var
+   a,b,a2,Uplmt: tIdx;
+begin
+  //Uplimt = a*a+b*b < Maxfactor | max(a,b) = Uplmt
+  Uplmt := Trunc(MaxFactor*sqrt(0.5));
+  For a := 1 to Uplmt  do
+  Begin
+    a2:= a*a;
+    For b := a downto 1 do
+      sumA2B2[b*b+a2] := 1
+  end;
+end;
+
+procedure CheckDifD2C2;
+var
+  d,d2,c : tIdx;
+begin
+  For d := 1 to MaxFactor do
+  Begin
+    //c < d => (d*d-c*c) > 0
+    d2 := d*d;
+    For c := d-1 downto 1 do
+    Begin
+      // d*d-c*c == (d+c)*(d-c) nonsense
+      if sumA2B2[d2-c*c] <> 0 then
+      Begin
+        Check[d] := 1;
+        //first for d found is enough
+        BREAK;
+      end;
+    end;
+  end;
+end;
+
+var
+  i : NativeUint;
+begin
+  BuildSumA2B2;
+  CheckDifD2C2;
+  //FindHoles
+  For i := 1 to MaxFactor do
+    If Check[i] = 0  then
+      write(i,' ');
+  writeln;
+end.