Idoneal numbers: Difference between revisions

Content added Content deleted
m (→‎{{header|Free Pascal}}: checked 2 versions, {$CODEALIGN loop=1} speeds up 50% isIdoneal(n.. ))
Line 82:
=={{header|Pascal}}==
==={{header|Free Pascal}}===
copy of Raku/Python etc only reducing multiplies in sum.</br>
version with minimized multiplications.
<syntaxhighlight lang="pascal">
program idoneals;
{$IFDEF FPC} {$MODE DELPHI}{$OPTIMIZATION ON,ALL}{$ENDIF}
{$MODE DELPHI}
{$IFDEF WINDOWS}{$APPTYPE CONSOLE}{$ENDIF}
{$OPTIMIZATION ON,ALL}
function isIdoneal(n: Uint32):Boolean;
{$CODEALIGN loop=1}
{$ENDIF}
{$IFDEF WINDOWS}
{$APPTYPE CONSOLE}
{$ENDIF}
 
uses
sysutils;
const
runs = 1000;
type
Check_isIdoneal = function(n: Uint32): boolean;
 
var
idoneals : array of Uint32;
 
function isIdonealOrg(n: Uint32):Boolean;
var
a,b,c,sum : Uint32NativeUint;
begin
For a := 1 to n do
Line 96 ⟶ 114:
if (a*b + a + b > n) then
BREAK;
sum := a*b + b*b + a*b;
For c := b+1 to n do
begin
{sum3 sum := a * b + b * c + a * c};
sum += a+b;
if (sum = n) then
EXIT(false);
if (sum > n) then
BREAK;
end;
end;
exit(true);
end;
 
function isIdoneal(n: Uint32):Boolean;
var
var
n ,l: Uint32;
// idonealsa,b,c,axb,ab,sum : array of Uint32;
begin
For a := 1 to n do
Begin
ab := a+a;
axb := a*a;
For b := a+1 to n do
Begin
axb += a;
ab +=1;
sum := axb + b*ab;
if (sum > n) then
BREAK;
For c := b+1 to n do
begin
sum += ab;
if (sum = n) then
EXIT(false);
if (sum > n) then
BREAK;
end;
end;
end;
EXIT(true);
end;
 
function Check(f:Check_isIdoneal):Uint32;
begin
var
l := 0;
For n := 1 to 1850 doUint32;
begin
if isIdoneal(n) then
result := 0;
For n := 1 to 1848 do
if f(n) then
Begin
inc(lresult);
// setlength(idoneals,lresult); idoneals[lresult-1] := n;
write(n:5)end;
end;
if l mod 13 = 0 then
 
Writeln;
procedure OneRun(f:Check_isIdoneal);
end;
var
end.</syntaxhighlight>
T0 : Int64;
i,l : Uint32;
begin
T0 := GetTickCount64;
For i := runs-1 downto 0 do
l:= check(f);
T0 := GetTickCount64-T0;
 
dec(l);
For i := 0 to l do
begin
write(idoneals[i]:5);
if (i+1) mod 13 = 0 then
writeln;
end;
 
Writeln(T0/runs:7:3,' ms per run');
end;
 
BEGIN
OneRun(@isIdonealOrg);
OneRun(@isIdoneal);
END.</syntaxhighlight>
{{out|@TIO.RUN}}
<pre>
Line 133 ⟶ 199:
120 130 133 165 168 177 190 210 232 240 253 273 280
312 330 345 357 385 408 462 520 760 840 1320 1365 1848
6.018 ms per run
 
1 2 3 4 5 6 7 8 9 10 12 13 15
Real time: 0.102 s User time: 0.081 s Sys. time: 0.020 s</pre>
16 18 21 22 24 25 28 30 33 37 40 42 45
48 57 58 60 70 72 78 85 88 93 102 105 112
120 130 133 165 168 177 190 210 232 240 253 273 280
312 330 345 357 385 408 462 520 760 840 1320 1365 1848
2.036 ms per run</pre>
 
=={{header|Phix}}==
Retrieved from "https://rosettacode.org/wiki/Idoneal_numbers"