Practical numbers: Difference between revisions

Content added Content deleted
m (→‎{{header|Pascal}}: renaming small modifications ( function to procedure ))
m (→‎{{header|Pascal}}: shorten SumAllSetsForPractical even faster)
Line 127: Line 127:
</pre>
</pre>
=={{header|Pascal}}==
=={{header|Pascal}}==
simple brute force.Marking sum of divs by shifting the former sum by the the next divisor.
simple brute force.Marking sum of divs by shifting the former sum by the the next divisor.<BR>
SumAllSetsForPractical tries to break as soon as possible.Should try to check versus [[wp:Practical number|https://en.wikipedia.org/wiki/Practical_number#Characterization_of_practical_numbers]]<BR>
<pre>
...σ denotes the sum of the divisors of x. For example, 2 × 3^2 × 29 × 823 = 429606 is practical,
because the inequality above holds for each of its prime factors:
3 ≤ σ(2) + 1 = 4, 29 ≤ σ(2 × 3^2) + 1 = 40, and 823 ≤ σ(2 × 3^2 × 29) + 1 = 1171. </pre>
<lang pascal>program practicalnumbers;
<lang pascal>program practicalnumbers;
{$IFDEF FPC}
{$IFDEF FPC}
{$MOde Delphi}{$OPTIMIZATION ON,ALL}
{$MODE DELPHI}{$OPTIMIZATION ON,ALL}
{$ELSE}
{$ELSE}
{$APPTYPE CONSOLE}
{$APPTYPE CONSOLE}
Line 147: Line 152:
Divs: tDivs;
Divs: tDivs;
HasSum :array of byte;
HasSum :array of byte;

procedure GetDivisors(var Divs:tdivs;n:Uint32);
procedure GetDivisors(var Divs:tdivs;n:Uint32);
//calc all divisors,keep sorted
//calc all divisors,keep sorted
Line 192: Line 196:
end;
end;


function SumAllSetsForPractical(Limit:Uint32):boolean;
procedure SumAllSets(n:Uint32);
//mark sum and than shift by next divisor == add
//mark sum and than shift by next divisor == add
//for practical numbers every sum must be marked
//for practical numbers every sum must be marked
var
var
hs : pByte;
hs0,hs1 : pByte;
idx,j,maxlimit,delta : INt32;
idx,j,loLimit,maxlimit,delta : NativeUint;
Begin
Begin
Limit := trunc(Limit*(Limit/Divs.DivsSumProp));
⚫
hs := @HasSum[0];
LoLimit:=0;
⚫
hs[0] := 1;//empty set
maxlimit := 0;
maxlimit := 0;
⚫
hs0 := @HasSum[0];
⚫
hs0[0] := 1;//empty set
for idx := 0 to Divs.DivsMaxIdx do
for idx := 0 to Divs.DivsMaxIdx do
Begin
Begin
delta := Divs.DivsVal[idx];
delta := Divs.DivsVal[idx];
hs1 := @hs0[delta];
For j := maxlimit downto 0 do
For j := maxlimit downto 0 do
hs[j+delta] := hs[j+delta] or hs[j];
hs1[j] := hs1[j] or hs0[j];
maxlimit += delta;
maxlimit += delta;
while hs0[LoLimit]<> 0 do
if maxLimit > n then break;
⚫
inc(LoLimit);
//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 (LoLimit < delta) OR (LoLimit > Limit) then
Break;
end;
end;
⚫
result := (LoLimit > Limit);
end;
end;


Line 227: Line 241:
i := n-1;
i := n-1;
sum := Divs.DivsSumProp;
sum := Divs.DivsSumProp;
if sum >= i then
if sum < i then
result := false
else
Begin
Begin
IF length(HasSum) > sum+8+1 then
IF length(HasSum) > sum+1+1 then
FillQWord(HasSum[0],(sum+8+1) DIV 8,0)
FillChar(HasSum[0],sum+1,#0)
else
else
Begin
Begin
// writeln(n,' must extend HasSum ',sum+8+1,sum/n:10:5);
setlength(HasSum,0);
setlength(HasSum,0);
setlength(HasSum,sum+8+1);
setlength(HasSum,sum+8+1);
end;
end;
SumAllSets(i);
result:=SumAllSetsForPractical(i);
while (i>= 0) AND (HasSum[i]<>0) do
⚫
dec(i);
end;
end;
⚫
result := i<0;
end;
end;


Line 283: Line 295:
OutIsPractical(954432);
OutIsPractical(954432);
OutIsPractical(720);
OutIsPractical(720);
OutIsPractical(5384);
OutIsPractical(1441440);
OutIsPractical(1441440);
writeln(Divs.DivsNum,' has ',Divs.DivsMaxIdx+1,' proper divisors');
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');
writeln((GetTickCount64-T0)/1000:10:3,' s');
T0 := GetTickCount64;
T0 := GetTickCount64;
Line 294: Line 311:
{{out}}
{{out}}
<pre> TIO.RUN.
<pre> TIO.RUN.

1 2 4 6 8 12 16 18 20 24
1 2 4 6 8 12 16 18 20 24
28 30 32 36 40 42 48 54 56 60
28 30 32 36 40 42 48 54 56 60
Line 309: Line 327:
954432 is not practical
954432 is not practical
720 is practical
720 is practical
5384 is not practical
1441440 is practical
1441440 is practical
1441440 has 287 proper divisors
1441440 has 287 proper divisors
0.050 s
0.017 s
99998640 is not practical
99998640 has 119 proper divisors
0.200 s // with reserving memory
99998640 is not practical
99998640 is not practical
99998640 has 119 proper divisors
99998640 has 119 proper divisors
1.480 s
0.081 s // already reserved memory


Real time: 1.688 s CPU share: 97.38 %</pre>
Real time: 0.506 s CPU share: 87.94 %</pre>


=={{header|Perl}}==
=={{header|Perl}}==
Retrieved from "https://rosettacode.org/wiki/Practical_numbers"