Anonymous user
Arithmetic numbers: Difference between revisions
m
→{{header|Pascal}}: added free pascal version
m (shorten function) |
m (→{{header|Pascal}}: added free pascal version) |
||
Line 237:
=={{header|Pascal}}==
{{works with| GNU Pascal}} and Free Pascal too.
<lang Pascal>
program ArithmeiticNumbers;
Line 293:
ArithmeticNumbers;
WriteLn('Hit Any Key');
{$IFDEF WINDOWS}ReadLn;{$ENDIF}
end.
</lang>
{{out|@TIO.RUN}}
<pre>
1 3 5 6 7 11 13 14 15 17 19 20 21 22 23 27 29 30 31 33
Line 310 ⟶ 309:
1228663 905043
Hit Any Key
Real time: 19.847 s CPU share: 99.36 %
</pre>
==={{header|Free Pascal}}===
using prime decomposition is lengthy, but much faster.
<lang pascal>
program ArithmeticNumbers;
{$OPTIMIZATION ON,ALL}
type
tPrimeFact = packed record
pfSumOfDivs,
pfRemain : Uint64;
pfDivCnt : Uint32;
pfMaxIdx : Uint32;
pfpotPrimIdx : array[0..9] of word;
pfpotMax : array[0..11] of byte;//11 instead of 9 for alignment
end;
var
SmallPrimes : array[0..6541] of word;
procedure InitSmallPrimes;
var
testPrime,j,p,idx:Uint32;
begin
SmallPrimes[0] := 2;
SmallPrimes[1] := 3;
idx := 1;
testPrime := 5;
repeat
For j := 1 to idx do
begin
p := SmallPrimes[j];
if p*p>testPrime then
BREAK;
if testPrime mod p = 0 then
Begin
p := 0;
BREAK;
end;
end;
if p <> 0 then
begin
inc(idx);
SmallPrimes[idx]:= testPrime;
end;
inc(testPrime,2);
until testPrime >= 65535;
end;
procedure smplPrimeDecomp(var PrimeFact:tPrimeFact;n:Uint32);
var
pr,i,pot,fac,q :NativeUInt;
Begin
with PrimeFact do
Begin
pfDivCnt := 1;
pfSumOfDivs := 1;
pfRemain := n;
pfMaxIdx := 0;
pfpotPrimIdx[0] := 1;
pfpotMax[0] := 0;
i := 0;
while i < High(SmallPrimes) do
begin
pr := SmallPrimes[i];
q := n DIV pr;
//if n < pr*pr
if pr > q then
BREAK;
if n = pr*q then
Begin
pfpotPrimIdx[pfMaxIdx] := i;
pot := 0;
fac := pr;
repeat
n := q;
q := n div pr;
pot+=1;
fac *= pr;
until n <> pr*q;
pfpotMax[pfMaxIdx] := pot;
pfDivCnt *= pot+1;
pfSumOfDivs *= (fac-1)DIV(pr-1);
inc(pfMaxIdx);
end;
inc(i);
end;
pfRemain := n;
if n > 1 then
Begin
pfDivCnt *= 2;
pfSumOfDivs *= n+1
end;
end;
end;
function IsArithmetic(const PrimeFact:tPrimeFact):boolean;inline;
begin
with PrimeFact do
IsArithmetic := pfSumOfDivs mod pfDivCnt = 0;
end;
var
pF :TPrimeFact;
i,cnt,primeCnt,lmt : Uint32;
begin
InitSmallPrimes;
writeln('First 100 arithemetic numbers');
cnt := 0;
i := 1;
repeat
smplPrimeDecomp(pF,i);
if IsArithmetic(pF) then
begin
write(i:4);
inc(cnt);
if cnt MOD 20 =0 then
writeln;
end;
inc(i);
until cnt = 100;
writeln;
writeln(' Arithemetic numbers');
writeln(' Index number composite');
cnt := 0;
primeCnt := 0;
lmt := 10;
i := 1;
repeat
smplPrimeDecomp(pF,i);
if IsArithmetic(pF) then
begin
inc(cnt);
if pF.pfRemain = i then
inc(primeCnt);
end;
if cnt = lmt then
begin
writeln(lmt:8,i:9,lmt-primeCnt:10);
lmt := lmt*10;
end;
inc(i);
until lmt>1000000;
{$IFdef WINDOWS}
WriteLn('Hit <ENTER>');ReadLn;
{$ENDIF}
end.</lang>
{{out|@TIO.RUN}}
<pre>
First 100 arithemetic numbers
1 3 5 6 7 11 13 14 15 17 19 20 21 22 23 27 29 30 31 33
35 37 38 39 41 42 43 44 45 46 47 49 51 53 54 55 56 57 59 60
61 62 65 66 67 68 69 70 71 73 77 78 79 83 85 86 87 89 91 92
93 94 95 96 97 99 101 102 103 105 107 109 110 111 113 114 115 116 118 119
123 125 126 127 129 131 132 133 134 135 137 138 139 140 141 142 143 145 147 149
Arithemetic numbers
Index number composite
10 17 3
100 149 65
1000 1361 782
10000 12953 8458
100000 125587 88219
1000000 1228663 905043
Real time: 0.678 s CPU share: 99.40 %</pre>
=={{header|Phix}}==
| |||