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: Line 82:
=={{header|Pascal}}==
=={{header|Pascal}}==
==={{header|Free Pascal}}===
==={{header|Free Pascal}}===
copy of Raku/Python etc only reducing multiplies in sum.
copy of Raku/Python etc only reducing multiplies in sum.</br>
version with minimized multiplications.
<syntaxhighlight lang="pascal">
<syntaxhighlight lang="pascal">
program idoneals;
program idoneals;
{$IFDEF FPC} {$MODE DELPHI}{$OPTIMIZATION ON,ALL}{$ENDIF}
{$IFDEF FPC}
{$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
var
a,b,c,sum : Uint32;
a,b,c,sum : NativeUint;
begin
begin
For a := 1 to n do
For a := 1 to n do
Line 96: Line 114:
if (a*b + a + b > n) then
if (a*b + a + b > n) then
BREAK;
BREAK;
sum := a*b + b*b + a*b;
For c := b+1 to n do
For c := b+1 to n do
begin
begin
{sum3 = a * b + b * c + a * c}
sum := a * b + b * c + a * c;
sum += a+b;
if (sum = n) then
if (sum = n) then
EXIT(false);
EXIT(false);
if (sum > n) then
if (sum > n) then
BREAK;
BREAK;
end;
end;
end;
end;
exit(true);
exit(true);
end;
end;


function isIdoneal(n: Uint32):Boolean;
var
var
n ,l: Uint32;
// idoneals : array of Uint32;
a,b,c,axb,ab,sum : 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 do
n : Uint32;
begin
if isIdoneal(n) then
result := 0;
For n := 1 to 1848 do
if f(n) then
Begin
Begin
inc(l);
inc(result);
// setlength(idoneals,l); idoneals[l-1] := n;
setlength(idoneals,result); idoneals[result-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}}
{{out|@TIO.RUN}}
<pre>
<pre>
Line 133: Line 199:
120 130 133 165 168 177 190 210 232 240 253 273 280
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
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}}==
=={{header|Phix}}==
Retrieved from "https://rosettacode.org/wiki/Idoneal_numbers"