Rosetta Code

Aliquot sequence classifications: Difference between revisions

Page Discussion

Aliquot sequence classifications (view source)

Revision as of 13:03, 2 May 2024

5,002 bytes added ,  29 days ago
add link to numberphile video
(→‎{{header|Vlang}}: Rename "Vlang" in "V (Vlang)")
(add link to numberphile video)
 
(8 intermediate revisions by 7 users not shown)
Line 31:
*   [[Amicable pairs]]
<br><br>
 
;External links:
* [https://www.youtube.com/watch?v=OtYKDzXwDEE An amazing thing about 276], Numberphile
 
=={{header|11l}}==
Line 1,599 ⟶ 1,602:
</pre>
 
=={{header|BASIC256BASIC}}==
==={{header|BASIC256}}===
{{trans|FreeBASIC}}
<syntaxhighlight lang="basic256"># Rosetta Code problem: http://rosettacode.org/wiki/Aliquot_sequence_classifications
Line 1,957 ⟶ 1,961:
336056, 1405725265675144, 1230017019320456, 68719476751
</pre>
 
 
=={{header|C#}}==
{{trans|Java}}
<syntaxhighlight lang="C#">
using System;
using System.Collections.Generic;
using System.Linq;
 
public class AliquotSequenceClassifications
{
private static long ProperDivsSum(long n)
{
return Enumerable.Range(1, (int)(n / 2)).Where(i => n % i == 0).Sum(i => (long)i);
}
 
public static bool Aliquot(long n, int maxLen, long maxTerm)
{
List<long> s = new List<long>(maxLen) {n};
long newN = n;
 
while (s.Count <= maxLen && newN < maxTerm)
{
newN = ProperDivsSum(s.Last());
 
if (s.Contains(newN))
{
if (s[0] == newN)
{
switch (s.Count)
{
case 1:
return Report("Perfect", s);
case 2:
return Report("Amicable", s);
default:
return Report("Sociable of length " + s.Count, s);
}
}
else if (s.Last() == newN)
{
return Report("Aspiring", s);
}
else
{
return Report("Cyclic back to " + newN, s);
}
}
else
{
s.Add(newN);
if (newN == 0)
return Report("Terminating", s);
}
}
 
return Report("Non-terminating", s);
}
 
static bool Report(string msg, List<long> result)
{
Console.WriteLine(msg + ": " + string.Join(", ", result));
return false;
}
 
public static void Main(string[] args)
{
long[] arr = {
11, 12, 28, 496, 220, 1184, 12496, 1264460,
790, 909, 562, 1064, 1488
};
 
Enumerable.Range(1, 10).ToList().ForEach(n => Aliquot(n, 16, 1L << 47));
Console.WriteLine();
foreach (var n in arr)
{
Aliquot(n, 16, 1L << 47);
}
}
}
</syntaxhighlight>
{{out}}
<pre>
Terminating: 1, 0
Terminating: 2, 1, 0
Terminating: 3, 1, 0
Terminating: 4, 3, 1, 0
Terminating: 5, 1, 0
Perfect: 6
Terminating: 7, 1, 0
Terminating: 8, 7, 1, 0
Terminating: 9, 4, 3, 1, 0
Terminating: 10, 8, 7, 1, 0
 
Terminating: 11, 1, 0
Terminating: 12, 16, 15, 9, 4, 3, 1, 0
Perfect: 28
Perfect: 496
Amicable: 220, 284
Amicable: 1184, 1210
Sociable of length 5: 12496, 14288, 15472, 14536, 14264
Sociable of length 4: 1264460, 1547860, 1727636, 1305184
Aspiring: 790, 650, 652, 496
Aspiring: 909, 417, 143, 25, 6
Cyclic back to 284: 562, 284, 220
Cyclic back to 1184: 1064, 1336, 1184, 1210
Non-terminating: 1488, 2480, 3472, 4464, 8432, 9424, 10416, 21328, 22320, 55056, 95728, 96720, 236592, 459792, 881392, 882384, 1474608
 
</pre>
 
 
=={{header|C++}}==
Line 2,362 ⟶ 2,476:
Cyclic back to 1184: [1064, 1336, 1184, 1210]
Non-terminating: [1488, 2480, 3472, 4464, 8432, 9424, 10416, 21328, 22320, 55056, 95728, 96720, 236592, 459792, 881392, 882384, 1474608]</pre>
 
=={{header|EasyLang}}==
{{trans|AWK}}
<syntaxhighlight lang=easylang>
fastfunc sumprop num .
if num = 1
return 0
.
sum = 1
root = sqrt num
i = 2
while i < root
if num mod i = 0
sum += i + num / i
.
i += 1
.
if num mod root = 0
sum += root
.
return sum
.
func$ tostr ar[] .
for v in ar[]
s$ &= " " & v
.
return s$
.
func$ class k .
oldk = k
newk = sumprop oldk
oldk = newk
seq[] &= newk
if newk = 0
return "terminating " & tostr seq[]
.
if newk = k
return "perfect " & tostr seq[]
.
newk = sumprop oldk
oldk = newk
seq[] &= newk
if newk = 0
return "terminating " & tostr seq[]
.
if newk = k
return "amicable " & tostr seq[]
.
for t = 4 to 16
newk = sumprop oldk
seq[] &= newk
if newk = 0
return "terminating " & tostr seq[]
.
if newk = k
return "sociable (period " & t - 1 & ") " & tostr seq[]
.
if newk = oldk
return "aspiring " & tostr seq[]
.
for i to len seq[] - 1
if newk = seq[i]
return "cyclic (at " & newk & ") " & tostr seq[]
.
.
if newk > 140737488355328
return "non-terminating (term > 140737488355328) " & tostr seq[]
.
oldk = newk
.
return "non-terminating (after 16 terms) " & tostr seq[]
.
print "Number classification sequence"
for j = 1 to 12
print j & " " & class j
.
for j in [ 28 496 220 1184 12496 1264460 790 909 562 1064 1488 15355717786080 ]
print j & " " & class j
.
</syntaxhighlight>
 
=={{header|EchoLisp}}==
Line 3,677 ⟶ 3,871:
 
=={{header|Nim}}==
<syntaxhighlight lang="nim">import std/[math, strformat, times]
from std/strutils import mathaddSep
import strformat
from strutils import addSep
import times
 
type
 
# Classification categories.
Category {.pure.} = enum
Unknown
Terminating = "terminating"
Line 3,697 ⟶ 3,888:
 
# Aliquot sequence.
AliquotSeq = seq[intint64]
 
const Limit = 2^47 # Limit beyond which the category is considered to be "NonTerminating".
Line 3,703 ⟶ 3,894:
#---------------------------------------------------------------------------------------------------
 
proc sumProperDivisors(n: intint64): intint64 =
## Compute the sum of proper divisors.*
 
if n == 1: return 0
result = 1
for d in 2..sqrt(n.toFloatfloat).int:
if n mod d == 0:
inc result, d
if n div d != d:
inc result, += n div d
 
#---------------------------------------------------------------------------------------------------
 
iterator aliquotSeq(n: intint64): intint64 =
## Yield the elements of the aliquot sequence of "n".
## Stopped if the current value is null or equal to "n".
Line 3,736 ⟶ 3,927:
#---------------------------------------------------------------------------------------------------
 
proc classification(n: intint64): tuple[cat: Category, values: AliquotSeq] =
## Return the category of the aliquot sequence of a number "n" and the sequence itself.
 
Line 3,768 ⟶ 3,959:
for n in 1..10:
let (cat, aseq) = classification(n)
echo fmt"{n:14}: {cat:<20} {aseq}"
 
echo ""
for n in [int64 11, 12, 28, 496, 220, 1184, 12496, 1264460,
790, 909, 562, 1064, 1488, 15355717786080.int]:
let (cat, aseq) = classification(n)
echo fmt"{n:14}: {cat:<20} {aseq}"
Line 4,818 ⟶ 5,009:
 
Both of the above limitations are imposed by this Rosetta Code task's restriction requirements: &nbsp; ''For the purposes of this task, ···''.
<syntaxhighlight lang="rexx">/*REXX program classifies various positive integers for For types of aliquot sequences. */
parseParse argArg low high $L LL /*obtain optional arguments from the CL*/
high= word(high low 10,1); low= word(low 1,1) /*obtain the LOW and HIGH (range). */
low=word(low 1,1) /*obtain the LOW and HIGH (range). */
if $L='' then $L=11 12 28 496 220 1184 12496 1264460 790 909 562 1064 1488 15355717786080
If LL='' Then
numeric digits 100 /*be able to compute the number: BIG */
LL=11 12 28 496 220 1184 12496 1264460 790 909 562 1064 1488 15355717786080
big= 2**47; NTlimit= 16 + 1 /*limits for a non─terminating sequence*/
numericNumeric Digits 20 digits max(9, length(big) ) /*be able toTo handlecompute bigthe numbersnumber: for //BIG */
big=2**47
digs= digits() /*used for align numbers for the output*/
#.NTlimit=16+1 .; #.0= 0; #.1= 0 /*#. are the proper divisorlimit sums.for a non-terminating sequence */
Numeric Digits max(9,length(big)) /*be able To handle big numbers For // */
say center('numbers from ' low " ───► " high ' (inclusive)', 153, "═")
digs=digits() do n=low to high; call classify n /*callused For aalign subroutinenumbers toFor classifythe number.output*/
dsum.=.
end /*n*/ /* [↑] process a range of integers. */
dsum.0=0
say
dsum.1=0 /* dsum. are the proper divisor sums. */
say center('first numbers for each classification', 153, "═")
Say 'Numbers from ' low ' ---> ' high ' (inclusive):'
class.= 0 /* [↓] ensure one number of each class*/
Do n=low To high do q=1 until class.sociable\==0 /*the onlyprocess specified range one that has to be counted. */
Call classify n call classify -q /*minus (-)call signsubroutine indicatesTo don'tclassify tellnumber. */
End
_= what; upper _ /*obtain the class and uppercase it. */
Say
class._= class._ + 1 /*bump counter for this class sequence.*/
Say 'First numbers for each classification:'
if class._==1 then say right(q, digs)':' center(what, digs) $
class.=0 end /*q*/ /* [↑?] onlyensure one displaynumber theof 1steach occurrenceclass*/
say Do q=1 Until class.sociable\==0 /*the only [↑]one that processhas untilTo allbe classescounted. found*/
Call classify -q /*minus (-) sign indicates don't tell. */
say center('classifications for specific numbers', 153, "═")
_=translate(what) do i=1 for words($L) /*$L:obtain the isclass aand listuppercase ofit. "special numbers".*/
class._=class._+1 call classify word($L, i) /*callbump acounter subroutineFor tothis classifyclass numbersequence.*/
If class._==1 Then end /*i*/ /*first number of this class /* [↑] process a list of integers. */
Call out q,what,dd
exit /*stick a fork in it, we're all done. */
End
/*──────────────────────────────────────────────────────────────────────────────────────*/
classify:Say parse arg a 1 aa; a= abs(a) /*obtain number[?] process that'sUntil toall beclasses classifiedfound*/
Say 'Classifications for specific numbers:'
if #.a\==. then s= #.a /*Was this number been summed before?*/
Do i=1 To words(LL) else s= sigma(a) /*No, thenprocess a classifylist numberof the"special hardnumbers" way*/
Call classify #.a= s word(LL,i) /*define sum ofcall thesubroutine To properclassify divisorsnumber. */
End
$= s /*define the start of integer sequence.*/
Exit what= 'terminating' /*assumestick thisa kindfork ofin classificationit,we're all done. */
out:
c.= 0 /*clear all cyclic sequences (to zero).*/
Parse arg number,class,dd
c.s= 1 /*set the first cyclic sequence. */
dd.=''
if $==a then what= 'perfect' /*check for a "perfect" number. */
Do di=1 By 1 While length(dd)>50
else do t=1 while s>0 /*loop until sum isn't 0 or > big.*/
do dj=50 To 10 By -1
m= s /*obtain the last number in sequence. */
If substr(dd,dj,1)=' ' Then Leave
if #.m==. then s= sigma(m) /*Not defined? Then sum proper divisors*/
End
else s= #.m /*use the previously found integer. */
dd.di=left(dd,dj)
if m==s then if m>=0 then do; what= 'aspiring'; leave; end
dd=substr(dd,dj+1)
parse var $ . word2 . /*obtain the 2nd number in sequence. */
End
if word2==a then do; what= 'amicable'; leave; end
dd.di=dd
$= $ s /*append a sum to the integer sequence.*/
Say right(number,digs)':' center(class,digs) dd.1||conti(1)
if s==a then if t>3 then do; what= 'sociable'; leave; end
Do di=2 By 1 While dd.di>''
if c.s then if m>0 then do; what= 'cyclic' ; leave; end
Say copies(' ',33)dd.di||conti(di)
c.s= 1 /*assign another possible cyclic number*/
End
/* [↓] Rosetta Code task's limit: >16 */
Return
if t>NTlimit then do; what= 'non─terminating'; leave; end
conti:
if s>big then do; what= 'NON─TERMINATING'; leave; end
Parse arg this
end /*t*/ /* [↑] only permit within reason. */
next=this+1
if aa>0 then say right(a, digs)':' center(what, digs) $
If dd.next>'' Then Return '...'
return /* [↑] only display if AA is positive*/
Else Return ''
/*──────────────────────────────────────────────────────────────────────────────────────*/
/*---------------------------------------------------------------------------------*/
sigma: procedure expose #. !.; parse arg x; if 11<2 then return 0; odd= x // 2
classify:
s= 1 /* [↓] use EVEN or ODD integers. ___*/
Parse Arg a 1 aa
do j=2+odd by 1+odd while j*j<x /*divide by all the integers up to √ X */
a=abs(a) if x//j==0 then s= s + j + x % j /*add the two divisors to the sum. /*obtain number that's to be classified*/
If dsum.a\==. Then
end /*j*/ /* [↓] adjust for square. ___*/
if j*js==xdsum.a then s= s + j /*Was X a square? /*Was Ifthis so,number addbeen √summed X before?*/
Else
#.x= s /*memoize division sum for argument X.*/
return s =dsum(a) /*returnNo,Then classify number the hard " " " " "way */</syntaxhighlight>
dsum.a=s /*define sum of the proper divisors. */
dd=s /*define the start of integer sequence.*/
what='terminating' /*assume this kind of classification. */
c.=0 /*clear all cyclic sequences (to zero).*/
c.s=1 /*set the first cyclic sequence. */
If dd==a Then
what='perfect' /*check For a "perfect" number. */
Else Do t=1 By 1 While s>0 /*loop Until sum isn't 0 or > big.*/
m=s /*obtain the last number in sequence. */
If dsum.m==. Then /*Not defined? */
s=dsum(m) /* compute sum pro of per divisors */
Else
s=dsum.m /*use the previously found integer. */
If m==s Then
If m>=0 Then Do
what='aspiring'
Leave
End
If word(dd,2)=a Then Do
what='amicable'
Leave
End
dd=dd s /*append a sum To the integer sequence.*/
If s==a Then
If t>3 Then Do
what='sociable'
Leave
End
If c.s Then
If m>0 Then Do
what='cyclic'
Leave
End
c.s=1 /*assign another possible cyclic number*/
/* [?] Rosetta Code task's limit: >16 */
If t>NTlimit Then Do
what='non-terminating'
Leave
End
If s>big Then Do
what='NON-TERMINATING'
Leave
End
End
If aa>0 Then /* display only if AA is positive */
Call out a,what,dd
Return
/*---------------------------------------------------------------------------------*/
dsum: Procedure Expose dsum. /* compute the sum of proper divisors */
Parse Arg x
If x<2 Then
Return 0
odd=x//2
s=1 /* use EVEN or ODD integers. */
Do j=2+odd by 1+odd While j*j<x /* divide by all the integers ) */
/* up to but excluding sqrt(x) */
If x//j==0 Then /* j is a divisor, so is x%j */
s=s+j+x%j /*add the two divisors To the sum. */
End
If j*j==x Then /* if x is a square */
s=s+j /* add sqrt(X) */
dsum.x=s /* memoize proper divisor sum of X */
Return s /* return the proper divisor sum */
</syntaxhighlight>
{{out|output|text=&nbsp; when using the default input:}}
<pre>Numbers from 1 ---> 10 (inclusive):
(Shown at three-quarter size.)
 
<pre style="font-size:75%">
═════════════════════════════════════════════════════════numbers from 1 ───► 10 (inclusive)══════════════════════════════════════════════════════════
1: terminating 0
2: terminating 1 0
Line 4,897 ⟶ 5,149:
10: terminating 8 7 1 0
 
First numbers for each classification:
══════════════════════════════════════════════════════════first numbers for each classification══════════════════════════════════════════════════════════
1: terminating 0
6: perfect 6
25: aspiring 6
138: non─terminatingnon-terminating 150 222 234 312 528 960 2088 3762 5598 6570 10746 13254 13830 19434 20886 21606 25098 26742 26754...
13254 13830 19434 20886 21606 25098 26742 26754
220: amicable 284 220
562: cyclic 284 220 284
12496: sociable 14288 15472 14536 14264 12496
 
Classifications for specific numbers:
══════════════════════════════════════════════════════════classifications for specific numbers═══════════════════════════════════════════════════════════
11: terminating 1 0
12: terminating 16 15 9 4 3 1 0
Line 4,919 ⟶ 5,172:
562: cyclic 284 220 284
1064: cyclic 1336 1184 1210 1184
1488: non─terminatingnon-terminating 2480 3472 4464 8432 9424 10416 21328 22320 55056 95728 96720 236592 459792 881392 882384 1474608 2461648 3172912 3173904...
95728 96720 236592 459792 881392 882384 1474608 ...
15355717786080: NON─TERMINATING 44534663601120 144940087464480
2461648 3172912 3173904
15355717786080: NON-TERMINATING 44534663601120 144940087464480
 
</pre>
 
Line 5,068 ⟶ 5,324:
Enter an integer:
Program complete.
</pre>
 
=={{header|RPL}}==
{{works with|HP|49}}
≪ DIVIS DUP SIZE
'''IF''' DUP 2 ≤ '''THEN''' 1 - NIP '''ELSE''' 1 SWAP 1 - SUB ∑LIST '''END'''
R→I
≫ ≫ ‘<span style="color:blue">∑PFAC</span>’ STO
≪ 16 2 47 ^ → smax vmax
≪ { } OVER +
'''DO'''
SWAP <span style="color:blue">∑PFAC</span> SWAP OVER +
'''UNTIL''' OVER NOT LASTARG vmax ≥ OR OVER SIZE smax ≥ OR
'''END''' NIP
≫ ≫ ‘<span style="color:blue">ALIQT</span>’ STO
≪ <span style="color:blue">ALIQT</span> DUP HEAD → seq k
≪ '''CASE'''
seq 0 POS '''THEN''' "terminating" '''END'''
seq 2 GET k == '''THEN''' "perfect" '''END'''
seq 3 GET k == '''THEN''' "amicable" '''END'''
seq 4 OVER SIZE SUB k POS '''THEN''' "sociable" '''END'''
seq ΔLIST 0 POS '''THEN''' "aspiring" '''END'''
seq SORT ΔLIST 0 POS '''THEN''' "cyclic" '''END'''
"non-terminating"
'''END'''
≫ ≫ ‘<span style="color:blue">ALIQLASS</span>’ STO
 
≪ n <span style="color:blue">ALIQLASS</span> ≫ 'n' 1 10 1 SEQ
{11 12 28 496 220 1184 12496 1264460 790 909 562 1064 1488 15355717786080} 1 ≪ <span style="color:blue">ALIQLASS</span> ≫ DOLIST
{{out}}
<pre>
2: { "terminating" "terminating" "terminating" "terminating" "terminating" "terminating" "perfect" "terminating" "terminating" "terminating" }
1: { "terminating" "terminating" "perfect" "perfect" "amicable" "amicable" "sociable" "sociable" "aspiring" "aspiring" "cyclic" "cyclic" "non-terminating" "non-terminating" }
</pre>
 
Line 5,703 ⟶ 5,995:
{{libheader|Wren-math}}
{{libheader|Wren-seq}}
<syntaxhighlight lang="ecmascriptwren">import "./fmt" for Conv, Fmt
import "./math" for Int, Nums
import "./seq" for Lst
class Classification {
Line 5,741 ⟶ 6,033:
for (k in 1..10) {
var c = classifySequence.call(k)
SystemFmt.print("%(Fmt.d(2, k))$2d: %(Fmt.s($-1515s $n", k, c.aliquot)), %(c.seq)")
}
Line 5,748 ⟶ 6,040:
for (k in a) {
var c = classifySequence.call(k)
SystemFmt.print("%(Fmt.d(7, k))$7d: %(Fmt.s($-1515s $n", k, c.aliquot)), %(c.seq)")
}
Line 5,755 ⟶ 6,047:
var c = classifySequence.call(k)
var seq = c.seq.map { |i| Conv.dec(i) }.toList // ensure 15 digit integer is printed in full
SystemFmt.print("%(k)$d: %(Fmt.s($-1515s $n", k, c.aliquot)), %(seq)")</syntaxhighlight>
 
{{out}}
Grondilu
1,934

edits

Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/332156...364185"