Anonymous user
Practical numbers: Difference between revisions
m
→{{header|Pascal}}: renaming small modifications ( function to procedure )
(→{{header|Pascal}}: new MarkSum some of divisors.Extremly faster than before.) |
m (→{{header|Pascal}}: renaming small modifications ( function to procedure )) |
||
Line 138:
type
tdivs = record
DivsVal : array[0..
DivsMaxIdx
DivsNum,
DivsSumProp :NativeUInt;
end;
Line 146 ⟶ 148:
HasSum :array of byte;
//calc all divisors,keep sorted
var
i,quot,ug,og :
Begin
with Divs do
ug := Low(tdivs.DivsVal);▼
Begin▼
og := High(tdivs.DivsVal);▼
▲ ug := Low(tdivs.DivsVal);
begin▼
▲ og := High(tdivs.DivsVal);
IF n mod i = 0 then▼
▲ begin
quot := n div i;
dec(og);▼
inc(ug);▼
end;▼
end;▼
If i*i = n then
Begin
dec(og);
end;▼
//move higher divisors down
while og < High(tDivs.DivsVal) do▼
begin▼
inc(og);
inc(ug);
end;
DivsSumProp := sum-n;
▲ end;
end;//with
▲ If i*i = n then
▲ Begin
▲ result.DivsVal[og] := i;
▲ dec(og);
▲ end;
▲ while og < High(tDivs.DivsVal) do
▲ begin
▲ inc(og);
▲ result.DivsVal[ug] := result.DivsVal[og];
▲ inc(ug);
▲ end;
end;
procedure
//mark sum and than shift by next divisor == add
//for practical numbers every sum must be marked
var
hs : pByte;
Line 187 ⟶ 200:
Begin
hs := @HasSum[0];
hs[0] := 1;//empty set
maxlimit := 0;
for idx := 0 to Divs.DivsMaxIdx do
Begin
delta := Divs.DivsVal[idx];
For j := maxlimit downto 0 do
hs[j+delta] := hs[j+delta] or hs[j];
maxlimit += delta;
▲ BREAK;
end;
end;
function isPractical(n:
var
i
sum:NativeUInt;
Begin
if n= 1 then
Line 212 ⟶ 224:
EXIT(false);
▲ sum := 0;
▲ sum += Divs.DivsVal[i];
i := n-1;
sum := Divs.DivsSumProp;
if sum >= i then
Begin
FillQWord(HasSum[0],(sum+8+1) DIV 8,0)
▲ MarkSum(i);
else
Begin
// writeln(n,' must extend HasSum ',sum+8+1,sum/n:10:5);
setlength(HasSum,0);▼
setlength(HasSum,sum+8+1);
end;
SumAllSets(i);
while (i>= 0) AND (HasSum[i]<>0) do
dec(i);
▲ setlength(HasSum,0);
end;
result := i<0;
Line 236 ⟶ 252:
end;
const
ColCnt = 10;
MAX = 333;
var
n,col,count : NativeInt;
Begin
For n := 1 to MAX do
if isPractical(n) then
begin
write(n:5);
if col = 0 then
Begin
▲ cnt := 11;
writeln;
col :=ColCnt;
end;
end;
writeln;
writeln('There are ',count,' pratical numbers from 1 to ',MAX);
writeln;
T0 := GetTickCount64;
OutIsPractical(666);
OutIsPractical(6666);
OutIsPractical(66666);
OutIsPractical(720);
▲ OutIsPractical(n);
writeln((GetTickCount64-T0)/1000:10:3,' s');
▲ writeln(n,' has ',Divs.DivsMaxIdx+1,' proper divisors');
T0 := GetTickCount64;
OutIsPractical(99998640);
</lang>▼
writeln(Divs.DivsNum,' has ',Divs.DivsMaxIdx+1,' proper divisors ');
writeln((GetTickCount64-T0)/1000:10:3,' s');
setlength(HasSum,0);
▲end.</lang>
{{out}}
<pre> TIO.RUN.
1 2 4 6 8 12 16 18 20 24
28 30 32 36 40 42 48 54 56 60
64 66 72 78 80 84 88 90 96 100
104 108 112 120 126 128 132 140 144 150
304 306 308 312 320 324 330
There are 77 pratical numbers from 1 to 333
666 is practical
6666 is practical
66666 is not practical
954432 is not practical
720 is practical
1441440 is practical
1441440 has 287 proper divisors
0.050 s
99998640 is not practical
99998640 has 119 proper divisors
1.480 s
=={{header|Perl}}==
| |||