Pythagorean quadruples: Difference between revisions

Content added Content deleted
m (→‎version 2: reduced runtime ( ~1/5 ) 22,000 from 0m4.184s downto 0m0,746s)
Line 1,338: Line 1,338:
Using a variant of [http://rosettacode.org/wiki/Pythagorean_quadruples#optimized REXX optimized] optimized<BR>
Using a variant of [http://rosettacode.org/wiki/Pythagorean_quadruples#optimized REXX optimized] optimized<BR>
As I now see the same as [http://rosettacode.org/wiki/Pythagorean_quadruples#ALGOL_68 Algol68]<BR>
As I now see the same as [http://rosettacode.org/wiki/Pythagorean_quadruples#ALGOL_68 Algol68]<BR>
a^2 + b^2 is like moving/jumping a rake with tines at a^2 from tine(1) to tine(MaxFactor) and mark their positions<BR>
Quite fast.
Quite fast.
<lang pascal>program pythQuad_2;
<lang pascal>program pythQuad_2;
Line 1,343: Line 1,344:
//a^2 + b^2 +c^2 = d^2
//a^2 + b^2 +c^2 = d^2
//a^2 + b^2 = d^2-c^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
const
MaxFactor =2200;
MaxFactor = 2200;//22000;//40960;
limit = MaxFactor*MaxFactor;
limit = MaxFactor*MaxFactor;
type
type
tIdx = NativeUint;
tIdx = NativeUint;
tSum = NativeUint;
tSum = NativeUint;
var
var
// global variables are initiated with 0 at startUp
// global variables are initiated with 0 at startUp
sumA2B2 :array[0..limit] of byte;
sumA2B2 :array[0..limit] of byte;
check : array[0..MaxFactor] of byte;
check : array[0..MaxFactor] of byte;


procedure BuildSumA2B2;
procedure BuildSumA2B2;
var
var
a,b : tIdx;
a,b,a2,Uplmt: tIdx;
s : tSum;
begin
begin
//Uplimt = a*a+b*b < Maxfactor | max(a,b) = Uplmt
For a := 1 to MaxFactor do
Uplmt := Trunc(MaxFactor*sqrt(0.5));
For b := 1 to a do
For a := 1 to Uplmt do
Begin
Begin
s := a*a+b*b;
a2:= a*a;
if s < limit then
sumA2B2[s] := 1
For b := a downto 1 do
else
sumA2B2[b*b+a2] := 1
break;
end;
end;
end;
end;


procedure CheckDifD2C2;
procedure CheckDifD2C2;
var
var
d,c : tIdx;
d,d2,c : tIdx;
s : tSum;
begin
begin
For d := 1 to MaxFactor do
For d := 1 to MaxFactor do
Begin
//c < d => (d*d-c*c) > 0
//c < d => (d*d-c*c) > 0
d2 := d*d;
For c := d-1 downto 1 do
For c := d-1 downto 1 do
Begin
Begin
s := d*d-c*c;
// d*d-c*c == (d+c)*(d-c) nonsense
if sumA2B2[s] <> 0 then
if sumA2B2[d2-c*c] <> 0 then
Begin
Check[d] := 1;
Check[d] := 1;
//first for d found is enough
BREAK;
end;
end;
end;
end;
end;
end;


Line 1,391: Line 1,404:
BuildSumA2B2;
BuildSumA2B2;
CheckDifD2C2;
CheckDifD2C2;
//FindHoles;
//FindHoles
For i := 1 to MaxFactor do
For i := 1 to MaxFactor do
If Check[i] = 0 then
If Check[i] = 0 then
write(i,' ');
write(i,' ');
writeln;
writeln;
end.</lang>
end.
</lang>
{{Out}}
{{Out}}
<pre>
<pre>
1 2 4 5 8 10 16 20 32 40 64 80 128 160 256 320 512 640 1024 1280 2048
1 2 4 5 8 10 16 20 32 40 64 80 128 160 256 320 512 640 1024 1280 2048
real 0m0.018s //4.8 Mb -> Level 3 cache 16 Mb ( Ryzen 5 1600 )
real 0m0,002s ( Ryzen 2200G 3.7 Ghz )
MaxFactor = 22000

.. 2048 2560 4096 5120 8192 10240 16384 20480
//MaxFactor =22000;484 Mb -> no level X Cache
real 0m0,746s
1 2 4 5 8 10 16 20 32 40 64 80 128 160 256 320 512 640 1024 1280 2048 2560 4096 5120 8192 10240 16384 20480
MaxFactor = 40960
real 0m4.184s
.. 2048 2560 4096 5120 8192 10240 16384 20480 32768 40960
real 0m3,222s
</pre>
</pre>