Practical numbers: Difference between revisions
m
Fix pascal version to run in delphi
m (→{{header|alternative}}: only memorizing heigher divisors) |
MaiconSoft (talk | contribs) m (Fix pascal version to run in delphi) |
||
Line 138:
{$ELSE}
{$APPTYPE CONSOLE}
{$ENDIF}
uses
sysutils
{$IFNDEF FPC}
,Windows
{$ENDIF}
;
const
LOW_DIVS = 0;
HIGH_DIVS = 2048 - 1;
type
tdivs = record
▲ DivsSumProp :NativeUInt;
▲ end;
var
Divs: tDivs;
HasSum
procedure GetDivisors(var Divs: tdivs; n: Uint32);
//calc all divisors,keep sorted
var
i, quot, ug,
sum: UInt64;
begin
with Divs do
DivsNum := n;
sum := 0;
ug :=
og :=
i := 1;
while i * i < n do
begin
quot := n div i;
DivsVal[og] := quot;
Divs.DivsVal[ug] := i;
inc(sum, quot + i);
dec(og);
inc(ug);
Line 178 ⟶ 189:
inc(i);
end;
DivsVal[og] := i;
inc(sum, i);
dec(og);
end;
//move higher divisors down
while og <
begin
inc(og);
Line 191 ⟶ 202:
inc(ug);
end;
DivsMaxIdx := ug - 2;
DivsSumProp := sum - n;
end; //with
end;
function SumAllSetsForPractical(Limit: Uint32): boolean;
//mark sum and than shift by next divisor == add
//for practical numbers every sum must be marked
var
hs0,
idx, j, loLimit, maxlimit,
begin
Limit := trunc(Limit * (Limit / Divs.DivsSumProp));
maxlimit := 0;
hs0 := @HasSum[0];
hs0[0] := 1; //empty set
for idx := 0 to Divs.DivsMaxIdx do
delta := Divs.DivsVal[idx];
hs1 := @hs0[delta];
hs1[j] :=
maxlimit
while hs0[
inc(
//IF there is a 0 < delta, it will never be set
//IF there are more than the Limit set,
//it will be copied by the following Delta's
if (
Break;
end;
result := (
end;
function isPractical(n: Uint32): boolean;
var
i: NativeInt;
sum: NativeUInt;
begin
if n = 1 then
EXIT(True);
if ODD(n) then
EXIT(false);
if (n > 2)
EXIT(false);
GetDivisors(Divs, n);
i := n - 1;
sum := Divs.DivsSumProp;
if sum < i then
result := false
else
FillChar(HasSum[0], sum + 1, #0)
else
setlength(HasSum, 0);
setlength(HasSum, sum + 8 + 1);
end;
result := SumAllSetsForPractical(i);
end;
end;
procedure OutIsPractical(n: nativeInt);
begin
writeln(n, ' is practical')
else
writeln(n, ' is not practical');
end;
const
var
T0
n, col,
begin
col := ColCnt;
count := 0;
if isPractical(n) then
begin
write(n: 5);
inc(count);
dec(col);
if col = 0 then
writeln;
col := ColCnt;
end;
end;
writeln;
writeln('There are ', count, ' pratical numbers from 1 to ', MAX);
writeln;
Line 297 ⟶ 310:
OutIsPractical(5384);
OutIsPractical(1441440);
writeln(Divs.DivsNum, ' has ', Divs.DivsMaxIdx + 1, ' proper divisors');
writeln((GetTickCount64 - T0) / 1000: 10: 3, ' s');
T0 := GetTickCount64;
OutIsPractical(99998640);
writeln(Divs.DivsNum, ' has ', Divs.DivsMaxIdx + 1, ' proper divisors ');
writeln((GetTickCount64 - T0) / 1000: 10: 3, ' s');
T0 := GetTickCount64;
OutIsPractical(99998640);
writeln(Divs.DivsNum, ' has ', Divs.DivsMaxIdx + 1, ' proper divisors ');
writeln((GetTickCount64 - T0) / 1000: 10: 3, ' s');
setlength(HasSum, 0);
{$IFNDEF UNIX} readln; {$ENDIF}
end.</lang>▼
end.
{{out}}
<pre> TIO.RUN.
|