Rosetta Code

Abundant, deficient and perfect number classifications: Difference between revisions

Page Discussion

Abundant, deficient and perfect number classifications (view source)

Revision as of 16:24, 14 March 2024

6,999 bytes added ,  2 months ago
Add ABC
m (→‎{{header|MiniScript}}: The factors get summed, not counted -doh!)
(Add ABC)
 
(21 intermediate revisions by 11 users not shown)
Line 678:
</pre>
 
=={{header|ABC}}==
<syntaxhighlight lang="abc">PUT 0 IN deficient
PUT 0 IN perfect
PUT 0 IN abundant
 
HOW TO FIND PROPER DIVISOR SUMS UP TO limit:
SHARE p
PUT {} IN p
FOR i IN {0..limit}: PUT 0 IN p[i]
FOR i IN {1..floor (limit/2)}:
PUT i+i IN j
WHILE j <= limit:
PUT p[j]+i IN p[j]
PUT j+i IN j
 
HOW TO CLASSIFY n:
SHARE deficient, perfect, abundant, p
SELECT:
p[n] < n: PUT deficient+1 IN deficient
p[n] = n: PUT perfect+1 IN perfect
p[n] > n: PUT abundant+1 IN abundant
 
PUT 20000 IN limit
FIND PROPER DIVISOR SUMS UP TO limit
FOR n IN {1..limit}: CLASSIFY n
 
WRITE deficient, "deficient"/
WRITE perfect, "perfect"/
WRITE abundant, "abundant"/</syntaxhighlight>
{{out}}
<Pre>15043 deficient
4 perfect
4953 abundant</Pre>
=={{header|Action!}}==
Because of the memory limitation on the non-expanded Atari 8-bit computer the array containing Proper Divisor Sums is generated and used twice for the first and the second half of numbers separately.
Line 1,539 ⟶ 1,572:
 
=={{header|BASIC}}==
{{works with|Chipmunk Basic}}
{{works with|GW-BASIC}}
{{works with|PC-BASIC|any}}
{{works with|QBasic}}
<syntaxhighlight lang="basic">10 DEFINT A-Z: LM=20000
20 DIM P(LM)
Line 1,554 ⟶ 1,591:
PERFECT: 4
ABUNDANT: 4953</pre>
 
==={{header|BASIC256}}===
<syntaxhighlight lang="vb">deficient = 0
perfect = 0
abundant = 0
 
for n = 1 to 20000
sum = SumProperDivisors(n)
begin case
case sum < n
deficient += 1
case sum = n
perfect += 1
else
abundant += 1
end case
next
 
print "The classification of the numbers from 1 to 20,000 is as follows :"
print
print "Deficient = "; deficient
print "Perfect = "; perfect
print "Abundant = "; abundant
end
 
function SumProperDivisors(number)
if number < 2 then return 0
sum = 0
for i = 1 to number \ 2
if number mod i = 0 then sum += i
next i
return sum
end function</syntaxhighlight>
{{out}}
<pre>Same as FreeBASIC entry.</pre>
 
==={{header|Chipmunk Basic}}===
{{works with|Chipmunk Basic|3.6.4}}
<syntaxhighlight lang="qbasic">100 cls
110 defic = 0
120 perfe = 0
130 abund = 0
140 for n = 1 to 20000
150 sump = SumProperDivisors(n)
160 if sump < n then
170 defic = defic+1
180 else
190 if sump = n then
200 perfe = perfe+1
210 else
220 if sump > n then abund = abund+1
230 endif
240 endif
250 next
260 print "The classification of the numbers from 1 to 20,000 is as follows :"
270 print
280 print "Deficient = ";defic
290 print "Perfect = ";perfe
300 print "Abundant = ";abund
310 end
320 function SumProperDivisors(number)
330 if number < 2 then SumProperDivisors = 0
340 sum = 0
350 for i = 1 to number/2
360 if number mod i = 0 then sum = sum+i
370 next i
380 SumProperDivisors = sum
390 end function</syntaxhighlight>
{{out}}
<pre>Same as FreeBASIC entry.</pre>
 
==={{header|Gambas}}===
{{trans|FreeBASIC}}
<syntaxhighlight lang="vbnet">Public Sub Main()
Dim sum As Integer, deficient As Integer, perfect As Integer, abundant As Integer
For n As Integer = 1 To 20000
sum = SumProperDivisors(n)
If sum < n Then
deficient += 1
Else If sum = n Then
perfect += 1
Else
abundant += 1
Endif
Next
Print "The classification of the numbers from 1 to 20,000 is as follows : \n"
Print "Deficient = "; deficient
Print "Perfect = "; perfect
Print "Abundant = "; abundant
End
 
Function SumProperDivisors(number As Integer) As Integer
If number < 2 Then Return 0
Dim sum As Integer = 0
For i As Integer = 1 To number \ 2
If number Mod i = 0 Then sum += i
Next
Return sum
End Function</syntaxhighlight>
{{out}}
<pre>Same as FreeBASIC entry.</pre>
 
==={{header|GW-BASIC}}===
{{works with|PC-BASIC|any}}
The [[#BASIC|BASIC]] solution works without any changes.
 
==={{header|QBasic}}===
The [[#BASIC|BASIC]] solution works without any changes.
 
==={{header|Run BASIC}}===
<syntaxhighlight lang="vb">function sumProperDivisors(num)
if num > 1 then
sum = 1
root = sqr(num)
for i = 2 to root
if num mod i = 0 then
sum = sum + i
if (i*i) <> num then sum = sum + num / i
end if
next i
end if
sumProperDivisors = sum
end function
 
deficient = 0
perfect = 0
abundant = 0
 
print "The classification of the numbers from 1 to 20,000 is as follows :"
 
for n = 1 to 20000
sump = sumProperDivisors(n)
if sump < n then
deficient = deficient +1
else
if sump = n then
perfect = perfect +1
else
if sump > n then abundant = abundant +1
end if
end if
next n
 
print "Deficient = "; deficient
print "Perfect = "; perfect
print "Abundant = "; abundant</syntaxhighlight>
 
==={{header|True BASIC}}===
<syntaxhighlight lang="qbasic">LET lm = 20000
DIM s(0)
MAT REDIM s(lm)
 
FOR i = 1 TO lm
LET s(i) = -32767
NEXT i
FOR i = 1 TO lm/2
FOR j = i+i TO lm STEP i
LET s(j) = s(j) +i
NEXT j
NEXT i
 
FOR i = 1 TO lm
LET x = i - 32767
IF s(i) < x THEN
LET d = d +1
ELSE
IF s(i) = x THEN
LET p = p +1
ELSE
LET a = a +1
END IF
END IF
NEXT i
 
PRINT "The classification of the numbers from 1 to 20,000 is as follows :"
PRINT
PRINT "Deficient ="; d
PRINT "Perfect ="; p
PRINT "Abundant ="; a
END</syntaxhighlight>
{{out}}
<pre>Similar to FreeBASIC entry.</pre>
 
=={{header|BCPL}}==
Line 2,155 ⟶ 2,380:
<pre>Abundant: 4953, Deficient: 15043, Perfect: 4
Abundant: 4953, Deficient: 15043, Perfect: 4</pre>
 
=={{header|EasyLang}}==
{{trans|AWK}}
 
<syntaxhighlight lang=easylang>
func sumprop num .
if num < 2
return 0
.
i = 2
sum = 1
root = sqrt num
while i < root
if num mod i = 0
sum += i + num / i
.
i += 1
.
if num mod root = 0
sum += root
.
return sum
.
for j = 1 to 20000
sump = sumprop j
if sump < j
deficient += 1
elif sump = j
perfect += 1
else
abundant += 1
.
.
print "Perfect: " & perfect
print "Abundant: " & abundant
print "Deficient: " & deficient
</syntaxhighlight>
 
=={{header|EchoLisp}}==
Line 2,207 ⟶ 2,469:
=={{header|Elena}}==
{{trans|C#}}
ELENA 46.x :
<syntaxhighlight lang="elena">import extensions;
 
Line 2,217 ⟶ 2,479:
int[] sum := new int[](bound + 1);
for(int divisor := 1,; divisor <= bound / 2,; divisor += 1)
{
for(int i := divisor + divisor,; i <= bound,; i += divisor)
{
sum[i] := sum[i] + divisor
Line 2,225 ⟶ 2,487:
};
for(int i := 1,; i <= bound,; i += 1)
{
int t := sum[i];
Line 2,587 ⟶ 2,849:
Abundant: 4953
</pre>
 
=={{header|FutureBasic}}==
<syntaxhighlight lang="futurebasic">
local fn SumProperDivisors( number as long ) as long
long i, result, sum = 0
if number < 2 then exit fn = 0
for i = 1 to number / 2
if number mod i == 0 then sum += i
next
result = sum
end fn = result
 
void local fn NumberCategories( limit as long )
long i, sum, deficient = 0, perfect = 0, abundant = 0
for i = 1 to limit
sum = fn SumProperDivisors(i)
if sum < i then deficient++ : continue
if sum == i then perfect++ : continue
abundant++
next
printf @"\nClassification of integers from 1 to %ld is:\n", limit
printf @"Deficient = %ld\nPerfect = %ld\nAbundant = %ld", deficient, perfect, abundant
printf @"-----------------\nTotal = %ld\n", deficient + perfect + abundant
end fn
 
CFTimeInterval t
t = fn CACurrentMediaTime
fn NumberCategories( 20000 )
printf @"Compute time: %.3f ms",(fn CACurrentMediaTime-t)*1000
 
HandleEvents
</syntaxhighlight>
{{output}}
<pre>
Classification of integers from 1 to 20000 is:
 
Deficient = 15043
Perfect = 4
Abundant = 4953
-----------------
Total = 20000
 
Compute time: 1761.443 ms
</pre>
 
 
=={{header|GFA Basic}}==
Line 2,931 ⟶ 3,240:
perfect: 4
abundant: 4953</pre>
 
{{Trans|Lua}}
<syntaxhighlight lang="javascript">
// classify the numbers 1 : 20 000 as abudant, deficient or perfect
"use strict"
let abundantCount = 0
let deficientCount = 0
let perfectCount = 0
const maxNumber = 20000
// construct a table of the proper divisor sums
let pds = []
pds[ 1 ] = 0
for( let i = 2; i <= maxNumber; i ++ ){ pds[ i ] = 1 }
for( let i = 2; i <= maxNumber; i ++ )
{
for( let j = i + i; j <= maxNumber; j += i ){ pds[ j ] += i }
}
// classify the numbers
for( let n = 1; n <= maxNumber; n ++ )
{
if( pds[ n ] < n )
{
deficientCount ++
}
else if( pds[ n ] == n )
{
perfectCount ++
}
else // pds[ n ] > n
{
abundantCount ++
}
}
console.log( "abundant " + abundantCount.toString() )
console.log( "deficient " + deficientCount.toString() )
console.log( "perfect " + perfectCount.toString() )
</syntaxhighlight>
{{out}}
<pre>
abundant 4953
deficient 15043
perfect 4
</pre>
 
=={{header|jq}}==
Line 3,049 ⟶ 3,401:
Abundant, 4953
</code>
 
=== Using Primes versions >= 0.5.4 ===
Recent revisions of the Primes package include a divisors() which returns divisors of n including 1 and n.
<syntaxhighlight lamg = "julia">using Primes
 
""" Return tuple of (perfect, abundant, deficient) counts from 1 up to nmax """
function per_abu_def_classify(nmax::Int)
results = [0, 0, 0]
for n in 1:nmax
results[sign(sum(divisors(n)) - 2 * n) + 2] += 1
end
return (perfect, abundant, deficient) = results
end
 
let MAX = 20_000
NPE, NAB, NDE = per_abu_def_classify(MAX)
println("$NPE perfect, $NAB abundant, and $NDE deficient numbers in 1:$MAX.")
end
</syntaxhighlight>{{out}}<pre>4 perfect, 4953 abundant, and 15043 deficient numbers in 1:20000.</pre>
 
=={{header|K}}==
Line 3,354 ⟶ 3,725:
Perfect 4
Abundant 4953
</pre>
 
=={{header|Maxima}}==
<syntaxhighlight lang="maxima">
/* Given a number it returns wether it is perfect, deficient or abundant */
number_class(n):=if divsum(n)-n=n then "perfect" else if divsum(n)-n<n then "deficient" else if divsum(n)-n>n then "abundant"$
 
/* Function that displays the number of each kind below n */
classification_count(n):=block(makelist(number_class(i),i,1,n),
[[length(sublist(%%,lambda([x],x="deficient")))," deficient"],[length(sublist(%%,lambda([x],x="perfect")))," perfect"],[length(sublist(%%,lambda([x],x="abundant")))," abundant"]])$
 
/* Test case */
classification_count(20000);
</syntaxhighlight>
{{out}}
<pre>
[[15043," deficient"],[4," perfect"],[4953," abundant"]]
</pre>
 
Line 3,590 ⟶ 3,978:
 
=={{header|Pascal}}==
==={{header|Free Pascal}}===
using the slightly modified http://rosettacode.org/wiki/Amicable_pairs#Alternative
{{libheader|PrimTrial}}
<syntaxhighlight lang="pascal">program AmicablePairs;
search for "UNIT for prime decomposition".
{find amicable pairs in a limited region 2..MAX
<syntaxhighlight lang="pascal">program KindOfN; //[deficient,perfect,abundant]
beware that >both< numbers must be smaller than MAX
there are 455 amicable pairs up to 524*1000*1000
correct up to
#437 460122410
}
//optimized for freepascal 2.6.4 32-Bit
{$IFDEF FPC}
{$MODE DELPHI}{$OPTIMIZATION ON,ALL}{$COPERATORS ON}{$CODEALIGN proc=16}
{$OPTIMIZATION ON,peephole,cse,asmcse,regvar}
{$CODEALIGN loop=1,proc=8}
{$ELSE}
{$APPTYPE CONSOLE}
{$ENDIF}
{$IFDEF WINDOWS} {$APPTYPE CONSOLE}{$ENDIF}
 
uses
sysutils;,PrimeDecomp // limited to 1.2e11
{$IFDEF WINDOWS},Windows{$ENDIF}
const
MAX = 20000;
//alternative copy and paste PrimeDecomp.inc for TIO.RUN
//{$IFDEF UNIX} MAX = 524*1000*1000;{$ELSE}MAX = 499*1000*1000;{$ENDIF}
{$I PrimeDecomp.inc}
type
tKindIdx = 0..2;//[deficient,perfect,abundant];
tValue = LongWord;
tKind = array[tKindIdx] of Uint64;
tpValue = ^tValue;
tPower = array[0..31] of tValue;
tIndex = record
idxI,
idxS : tValue;
end;
tdpa = array[0..2] of LongWord;
var
power : tPower;
PowerFac : tPower;
DivSumField : array[0..MAX] of tValue;
Indices : array[0..511] of tIndex;
DpaCnt : tdpa;
 
procedure InitGetKind(Limit:Uint64);
var
pPrimeDecomp :tpPrimeFac;
i : LongInt;
SumOfKind : tKind;
begin
n: NativeUInt;
DivSumField[0]:= 0;
c: NativeInt;
For i := 1 to MAX do
T0:Int64;
DivSumField[i]:= 1;
Begin
end;
writeln('Limit: ',LIMIT);
 
T0 := GetTickCount64;
procedure ProperDivs(n: tValue);
fillchar(SumOfKind,SizeOf(SumOfKind),#0);
//Only for output, normally a factorication would do
n := 1;
var
Init_Sieve(n);
su,so : string;
i,q : tValue;
begin
su:= '1';
so:= '';
i := 2;
while i*i <= n do
begin
q := n div i;
IF q*i -n = 0 then
begin
su:= su+','+IntToStr(i);
IF q <> i then
so:= ','+IntToStr(q)+so;
end;
inc(i);
end;
writeln(' [',su+so,']');
end;
 
procedure AmPairOutput(cnt:tValue);
var
i : tValue;
r : double;
begin
r := 1.0;
For i := 0 to cnt-1 do
with Indices[i] do
begin
writeln(i+1:4,IdxI:12,IDxS:12,' ratio ',IdxS/IDxI:10:7);
if r < IdxS/IDxI then
r := IdxS/IDxI;
IF cnt < 20 then
begin
ProperDivs(IdxI);
ProperDivs(IdxS);
end;
end;
writeln(' max ratio ',r:10:4);
end;
 
function Check:tValue;
var
i,s,n : tValue;
begin
fillchar(DpaCnt,SizeOf(dpaCnt),#0);
n := 0;
For i := 1 to MAX do
begin
//s = sum of proper divs (I) == sum of divs (I) - I
s := DivSumField[i]-i;
IF (s <=MAX) AND (s>i) then
begin
IF DivSumField[s]-s = i then
begin
With indices[n] do
begin
idxI := i;
idxS := s;
end;
inc(n);
end;
end;
inc(DpaCnt[Ord(s>=i)-Ord(s<=i)+1]);
end;
result := n;
end;
 
Procedure CalcPotfactor(prim:tValue);
//PowerFac[k] = (prim^(k+1)-1)/(prim-1) == Sum (i=1..k) prim^i
var
k: tValue;
Pot, //== prim^k
PFac : Int64;
begin
Pot := prim;
PFac := 1;
For k := 0 to High(PowerFac) do
begin
PFac := PFac+Pot;
IF (POT > MAX) then
BREAK;
PowerFac[k] := PFac;
Pot := Pot*prim;
end;
end;
 
procedure InitPW(prim:tValue);
begin
fillchar(power,SizeOf(power),#0);
CalcPotfactor(prim);
end;
 
function NextPotCnt(p: tValue):tValue;inline;
//return the first power <> 0
//power == n to base prim
var
i : tValue;
begin
result := 0;
repeat
i pPrimeDecomp:= power[result]GetNextPrimeDecomp;
c := pPrimeDecomp^.pfSumOfDivs-2*n;
Inc(i);
c := ORD(c>0)-ORD(c<0)+1;//sgn(c)+1
IF i < p then
inc(SumOfKind[c]);
BREAK
elseinc(n);
until n begin> LIMIT;
iT0 := 0GetTickCount64-T0;
writeln('deficient: ',SumOfKind[0]);
power[result] := 0;
writeln('abundant: ',SumOfKind[2]);
inc(result);
writeln('perfect: ',SumOfKind[1]);
end;
writeln('runtime ',T0/1000:0:3,' s');
until false;
writeln;
power[result] := i;
end;
 
Begin
function Sieve(prim: tValue):tValue;
InitSmallPrimes; //using PrimeDecomp.inc
//simple version
GetKind(20000);
var
GetKind(10*1000*1000);
actNumber : tValue;
GetKind(524*1000*1000);
begin
end.</syntaxhighlight>{{out|@TIO.RUN}}
while prim <= MAX do
<pre>Limit: 20000
begin
deficient: 15043
InitPW(prim);
abundant: 4953
//actNumber = actual number = n*prim
perfect: 4
//power == n to base prim
runtime 0.003 s
actNumber := prim;
while actNumber < MAX do
begin
DivSumField[actNumber] := DivSumField[actNumber] *PowerFac[NextPotCnt(prim)];
inc(actNumber,prim);
end;
//next prime
repeat
inc(prim);
until (DivSumField[prim] = 1);
end;
result := prim;
end;
 
Limit: 1000000
var
deficient: 752451
T2,T1,T0: TDatetime;
abundant: 247545
APcnt: tValue;
perfect: 4
runtime 0.052 s
 
Limit: 524000000
begin
deficient: 394250308
T0:= time;
abundant: 129749687
Init;
perfect: 5
Sieve(2);
runtime 32.987 s
T1:= time;
APCnt := Check;
T2:= time;
//AmPairOutput(APCnt);
writeln(Max:10,' upper limit');
writeln(DpaCnt[0]:10,' deficient');
writeln(DpaCnt[1]:10,' perfect');
writeln(DpaCnt[2]:10,' abundant');
writeln(DpaCnt[2]/Max:14:10,' ratio abundant/upper Limit ');
writeln(DpaCnt[0]/Max:14:10,' ratio abundant/upper Limit ');
writeln(DpaCnt[2]/DpaCnt[0]:14:10,' ratio abundant/deficient ');
writeln('Time to calc sum of divs ',FormatDateTime('HH:NN:SS.ZZZ' ,T1-T0));
writeln('Time to find amicable pairs ',FormatDateTime('HH:NN:SS.ZZZ' ,T2-T1));
{$IFNDEF UNIX}
readln;
{$ENDIF}
end.
</syntaxhighlight>
output
<pre>
20000 upper limit
15043 deficient
4 perfect
4953 abundant
0.2476500000 ratio abundant/upper Limit
0.7521500000 ratio abundant/upper Limit
0.3292561324 ratio abundant/deficient
Time to calc sum of divs 00:00:00.000
Time to find amicable pairs 00:00:00.000
 
Real time: 33.203 s User time: 32.881 s Sys. time: 0.048 s CPU share: 99.17 %
...
524000000 upper limit
394250308 deficient
5 perfect
129749687 abundant
0.2476139065 ratio abundant/upper Limit
0.7523860840 ratio abundant/upper Limit
0.3291048463 ratio abundant/deficient
Time to calc sum of divs 00:00:12.597
Time to find amicable pairs 00:00:04.064
</pre>
 
Line 4,875 ⟶ 5,096:
 
===Task using modulo/division===
{{Trans|Lua|CountingSumming the factors using modulo/division}}
<syntaxhighlight lang="ring">
a = 0
Line 4,913 ⟶ 5,134:
 
===Task using a table===
{{Trans|Lus|CountingSummiing the factors using a table}}
<syntaxhighlight lang="ring">
maxNumber = 20000
Line 4,947 ⟶ 5,168:
Deficient: 15043
Perfect : 4
</pre>
 
=={{header|RPL}}==
{{works with|HP|49}}
≪ [1 0 0]
2 20000 '''FOR''' n
n DIVIS REVLIST TAIL <span style="color:grey">@ get the list of divisors of n excluding n</span>
0. + <span style="color:grey">@ avoid ∑LIST and SIGN errors when n is prime </span>
∑LIST n - SIGN 2 + <span style="color:grey">@ turn P(n)-n into 1, 2 or 3</span>
DUP2 GET 1 + PUT <span style="color:grey">@ increment appropriate array element</span>
'''NEXT'''
≫ '<span style="color:blue">TASK</span>' STO
{{out}}
<pre>
1: [15042 4 4953]
</pre>
 
Line 5,077 ⟶ 5,313:
Abundant: 4953
</pre>
 
=={{header|SETL}}==
<syntaxhighlight lang="setl">program classifications;
P := properdivisorsums(20000);
 
print("Deficient:", #[n : n in [1..#P] | P(n) < n]);
print(" Perfect:", #[n : n in [1..#P] | P(n) = n]);
print(" Abundant:", #[n : n in [1..#P] | P(n) > n]);
 
proc properdivisorsums(n);
p := [0];
loop for i in [1..n] do
loop for j in [i*2, i*3..n] do
p(j) +:= i;
end loop;
end loop;
return p;
end proc;
end program;</syntaxhighlight>
{{out}}
<pre>Deficient: 15043
Perfect: 4
Abundant: 4953</pre>
 
=={{header|Sidef}}==
Line 5,509 ⟶ 5,768:
===Using modulo/division===
{{libheader|Wren-math}}
<syntaxhighlight lang="ecmascriptwren">import "./math" for Int, Nums
 
var d = 0
Line 5,539 ⟶ 5,798:
{{Trans|Lua|Summing the factors using a table}}
 
<syntaxhighlight lang="ecmascriptwren">var maxNumber = 20000
var maxNumber = 20000
var abundantCount = 0
var deficientCount = 0
var perfectCount = 0
 
var pds = []
pds.add( 0 ) // element 0
pds.add( 0 ) // element 1
for ( i in 2 .. maxNumber) ){
pds.add( 1 )
}
for ( i in 2 .. maxNumber) ){
var j = i + i
while( (j <= maxNumber ) {
pds[ j ] = pds[ j ] + i
j = j + i
}
}
for ( n in 1 .. maxNumber) ){
var pdSum = pds[ n ]
if ( pdSum < n) ){
deficientCount = deficientCount + 1
} else if ( pdSum == n) ){
perfectCount = perfectCount + 1
} else { // pdSum > n
abundantCount = abundantCount + 1
}
}
 
System.print( "Abundant : %(abundantCount)" + abundantCount.toString )
System.print( "Deficient: %(deficientCount)" + deficientCount.toString )
System.print( "Perfect : %(perfectCount)" + perfectCount.toString )</syntaxhighlight>
</syntaxhighlight>
 
{{out}}
<pre>
Abundant : 49524953
Deficient: 1504415043
Perfect : 4
</pre>
Not a robot
2,093

edits

Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/346048...361894"