aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Data commit

Browse source
This commit is contained in:
Ingy döt Net 2023-07-01 11:58:00 -04:00
parent 7387c8f97b
commit cb5bb5e222
199093 changed files with 3378972 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

2
Task/Aliquot-sequence-classifications/00-META.yaml Normal file
View file

@ -0,0 +1,2 @@
---
from: http://rosettacode.org/wiki/Aliquot_sequence_classifications

32
Task/Aliquot-sequence-classifications/00-TASK.txt Normal file
View file

@ -0,0 +1,32 @@
An [[wp:Aliquot sequence|aliquot sequence]] of a positive integer K is defined recursively as the first member
being K and subsequent members being the sum of the [[Proper divisors]] of the previous term.
:* If the terms eventually reach 0 then the series for K is said to '''terminate'''.
:<br>There are several classifications for non termination:
:* If the second term is K then all future terms are also K and so the sequence repeats from the first term with period 1 and K is called '''perfect'''.
:* If the third term ''would'' be repeating K then the sequence repeats with period 2 and K is called '''amicable'''.
:* If the N<sup>th</sup> term ''would'' be repeating K for the first time, with N > 3 then the sequence repeats with period N - 1 and K is called '''sociable'''.
:<br>Perfect, amicable and sociable numbers eventually repeat the original number K; there are other repetitions...
:* Some K have a sequence that eventually forms a periodic repetition of period 1 but of a number other than K, for example 95 which forms the sequence <code>95, 25, 6, 6, 6, ...</code> such K are called '''aspiring'''.
:* K that have a sequence that eventually forms a periodic repetition of period >= 2 but of a number other than K, for example 562 which forms the sequence <code>562, 284, 220, 284, 220, ...</code> such K are called '''cyclic'''.
:<br>And finally:
:* Some K form aliquot sequences that are not known to be either terminating or periodic; these K are to be called '''non-terminating'''. <br>For the purposes of this task, K is to be classed as non-terminating if it has not been otherwise classed after generating '''16''' terms or if any term of the sequence is greater than 2**47 = 140,737,488,355,328.
;Task:
# Create routine(s) to generate the aliquot sequence of a positive integer enough to classify it according to the classifications given above.
# Use it to display the classification and sequences of the numbers one to ten inclusive.
# Use it to show the classification and sequences of the following integers, in order:
:: 11, 12, 28, 496, 220, 1184, 12496, 1264460, 790, 909, 562, 1064, 1488, and optionally 15355717786080.
Show all output on this page.
;Related tasks:
* &nbsp; [[Abundant, deficient and perfect number classifications]]. (Classifications from only the first two members of the whole sequence).
* &nbsp; [[Proper divisors]]
* &nbsp; [[Amicable pairs]]
<br><br>

38
Task/Aliquot-sequence-classifications/11l/aliquot-sequence-classifications.11l Normal file
View file

@ -0,0 +1,38 @@
F pdsum(n)
R sum((1 .. (n + 1) I/ 2).filter(x -> @n % x == 0 & @n != x))
F aliquot(n, maxlen = 16, maxterm = 2 ^ 30)
I n == 0
R (‘terminating’, [0])
V s = [n]
V slen = 1
V new = n
L slen <= maxlen & new < maxterm
new = pdsum(s.last)
I new C s
I s[0] == new
I slen == 1
R (‘perfect’, s)
E I slen == 2
R (‘amicable’, s)
E
R (‘sociable of length #.’.format(slen), s)
E I s.last == new
R (‘aspiring’, s)
E
R (‘cyclic back to #.’.format(new), s)
E I new == 0
R (‘terminating’, s [+] [0])
E
s.append(new)
slen++
L.was_no_break
R (‘non-terminating’, s)
L(n) 1..10
V (cls, seq) = aliquot(n)
print(‘#.: #.’.format(cls, seq))
print()
L(n) [11, 12, 28, 496, 220, 1184, 12496, 1264460, 790, 909, 562, 1064, 1488]
V (cls, seq) = aliquot(n)
print(‘#.: #.’.format(cls, seq))

556
Task/Aliquot-sequence-classifications/AArch64-Assembly/aliquot-sequence-classifications.aarch64 Normal file
View file

@ -0,0 +1,556 @@
/* ARM assembly AARCH64 Raspberry PI 3B or android 64 bits */
/* program aliquotSeq64.s */
/*******************************************/
/* Constantes file */
/*******************************************/
/* for this file see task include a file in language AArch64 assembly*/
.include "../includeConstantesARM64.inc"
.equ MAXINUM, 10
.equ MAXI, 16
.equ NBDIVISORS, 1000
/*******************************************/
/* Initialized data */
/*******************************************/
.data
szMessStartPgm: .asciz "Program 64 bits start \n"
szMessEndPgm: .asciz "Program normal end.\n"
szMessErrorArea: .asciz "\033[31mError : area divisors too small.\033[0m \n"
szMessError: .asciz "\033[31m\nError !!!\033[0m \n"
szMessErrGen: .asciz "\033[31mError end program.\033[0m \n"
szMessOverflow: .asciz "\033[31mOverflow function isPrime.\033[0m \n"
szCarriageReturn: .asciz "\n"
szLibPerf: .asciz "Perfect \n"
szLibAmic: .asciz "Amicable \n"
szLibSoc: .asciz "Sociable \n"
szLibAspi: .asciz "Aspiring \n"
szLibCycl: .asciz "Cyclic \n"
szLibTerm: .asciz "Terminating \n"
szLibNoTerm: .asciz "No terminating\n"
/* datas message display */
szMessResult: .asciz " @ "
szMessResHead: .asciz "Number @ :"
.align 4
tbNumber: .quad 11,12,28,496,220,1184,12496,1264460,790,909,562,1064,1488
.equ NBNUMBER, (. - tbNumber ) / 8
/*******************************************/
/* UnInitialized data */
/*******************************************/
.bss
.align 4
sZoneConv: .skip 24
tbZoneDecom: .skip 8 * NBDIVISORS // facteur 4 octets
tbNumberSucc: .skip 8 * MAXI
/*******************************************/
/* code section */
/*******************************************/
.text
.global main
main: // program start
ldr x0,qAdrszMessStartPgm // display start message
bl affichageMess
mov x4,#1
1:
mov x0,x4 // number
bl aliquotClassif // aliquot classification
cmp x0,#-1 // error ?
beq 99f
add x4,x4,#1
cmp x4,#MAXINUM
ble 1b
ldr x5,qAdrtbNumber // number array
mov x4,#0
2:
ldr x0,[x5,x4,lsl #3] // load a number
bl aliquotClassif // aliquot classification
cmp x0,#-1 // error ?
beq 99f
add x4,x4,#1 // next number
cmp x4,#NBNUMBER // maxi ?
blt 2b // no -> loop
ldr x0,qAdrszMessEndPgm // display end message
bl affichageMess
b 100f
99: // display error message
ldr x0,qAdrszMessError
bl affichageMess
100: // standard end of the program
mov x0, #0 // return code
mov x8, #EXIT // request to exit program
svc 0 // perform system call
qAdrszMessStartPgm: .quad szMessStartPgm
qAdrszMessEndPgm: .quad szMessEndPgm
qAdrszMessError: .quad szMessError
qAdrszCarriageReturn: .quad szCarriageReturn
qAdrtbZoneDecom: .quad tbZoneDecom
qAdrszMessResult: .quad szMessResult
qAdrsZoneConv: .quad sZoneConv
qAdrtbNumber: .quad tbNumber
/******************************************************************/
/* function aliquot classification */
/******************************************************************/
/* x0 contains number */
aliquotClassif:
stp x4,lr,[sp,-16]! // save registres
stp x5,x6,[sp,-16]! // save registres
stp x7,x8,[sp,-16]! // save registres
mov x5,x0 // save number
ldr x1,qAdrsZoneConv
bl conversion10 // convert ascii string
strb wzr,[x1,x0]
ldr x0,qAdrszMessResHead
ldr x1,qAdrsZoneConv
bl strInsertAtCharInc // put in head message
bl affichageMess // and display
mov x0,x5 // restaur number
ldr x7,qAdrtbNumberSucc // number successif array
mov x4,#0 // counter number successif
1:
mov x6,x0 // previous number
ldr x1,qAdrtbZoneDecom
bl decompFact // create area of divisors
cmp x0,#0 // error ?
blt 99f
sub x3,x1,x6 // sum
mov x0,x3
ldr x1,qAdrsZoneConv
bl conversion10 // convert ascii string
strb wzr,[x1,x0]
ldr x0,qAdrszMessResult
ldr x1,qAdrsZoneConv
bl strInsertAtCharInc // and put in message
bl affichageMess
cmp x3,#0 // sum = zero
bne 11f
ldr x0,qAdrszLibTerm // terminating
bl affichageMess
b 100f
11:
cmp x5,x3 // compare number and sum
bne 4f
cmp x4,#0 // first loop ?
bne 2f
ldr x0,qAdrszLibPerf // perfect
bl affichageMess
b 100f
2:
cmp x4,#1 // second loop ?
bne 3f
ldr x0,qAdrszLibAmic // amicable
bl affichageMess
b 100f
3: // other loop
ldr x0,qAdrszLibSoc // sociable
bl affichageMess
b 100f
4:
cmp x6,x3 // compare sum and (sum - 1)
bne 5f
ldr x0,qAdrszLibAspi // aspirant
bl affichageMess
b 100f
5:
cmp x3,#1 // if one ,no search in array
beq 7f
mov x2,#0 // search indice
6: // search number in array
ldr x9,[x7,x2,lsl #3]
cmp x9,x3 // equal ?
beq 8f // yes -> cycling
add x2,x2,#1 // increment indice
cmp x2,x4 // end ?
blt 6b // no -> loop
7:
cmp x4,#MAXI
blt 10f
ldr x0,qAdrszLibNoTerm // no terminating
bl affichageMess
b 100f
8: // cycling
ldr x0,qAdrszLibCycl
bl affichageMess
b 100f
10:
str x3,[x7,x4,lsl #3] // store new sum in array
add x4,x4,#1 // increment counter
mov x0,x3 // new number = new sum
b 1b // and loop
99: // display error
ldr x0,qAdrszMessError
bl affichageMess
mov x0,-1
100:
ldp x7,x8,[sp],16 // restaur des 2 registres
ldp x5,x6,[sp],16 // restaur des 2 registres
ldp x4,lr,[sp],16 // restaur des 2 registres
ret
qAdrszMessResHead: .quad szMessResHead
qAdrszLibPerf: .quad szLibPerf
qAdrszLibAmic: .quad szLibAmic
qAdrszLibSoc: .quad szLibSoc
qAdrszLibCycl: .quad szLibCycl
qAdrszLibAspi: .quad szLibAspi
qAdrszLibNoTerm: .quad szLibNoTerm
qAdrszLibTerm: .quad szLibTerm
qAdrtbNumberSucc: .quad tbNumberSucc
/******************************************************************/
/* decomposition en facteur */
/******************************************************************/
/* x0 contient le nombre à decomposer */
/* x1 contains factor area address */
decompFact:
stp x3,lr,[sp,-16]! // save registres
stp x4,x5,[sp,-16]! // save registres
stp x6,x7,[sp,-16]! // save registres
stp x8,x9,[sp,-16]! // save registres
stp x10,x11,[sp,-16]! // save registres
mov x5,x1
mov x1,x0
cmp x0,1
beq 100f
mov x8,x0 // save number
bl isPrime // prime ?
cmp x0,#1
beq 98f // yes is prime
mov x1,#1
str x1,[x5] // first factor
mov x12,#1 // divisors sum
mov x4,#1 // indice divisors table
mov x1,#2 // first divisor
mov x6,#0 // previous divisor
mov x7,#0 // number of same divisors
2:
mov x0,x8 // dividende
udiv x2,x0,x1 // x1 divisor x2 quotient x3 remainder
msub x3,x2,x1,x0
cmp x3,#0
bne 5f // if remainder <> zero -> no divisor
mov x8,x2 // else quotient -> new dividende
cmp x1,x6 // same divisor ?
beq 4f // yes
mov x7,x4 // number factors in table
mov x9,#0 // indice
21:
ldr x10,[x5,x9,lsl #3 ] // load one factor
mul x10,x1,x10 // multiply
str x10,[x5,x7,lsl #3] // and store in the table
adds x12,x12,x10
bcs 99f
add x7,x7,#1 // and increment counter
add x9,x9,#1
cmp x9,x4
blt 21b
mov x4,x7
mov x6,x1 // new divisor
b 7f
4: // same divisor
sub x9,x4,#1
mov x7,x4
41:
ldr x10,[x5,x9,lsl #3 ]
cmp x10,x1
sub x13,x9,1
csel x9,x13,x9,ne
bne 41b
sub x9,x4,x9
42:
ldr x10,[x5,x9,lsl #3 ]
mul x10,x1,x10
str x10,[x5,x7,lsl #3] // and store in the table
adds x12,x12,x10
bcs 99f
add x7,x7,#1 // and increment counter
add x9,x9,#1
cmp x9,x4
blt 42b
mov x4,x7
b 7f // and loop
/* not divisor -> increment next divisor */
5:
cmp x1,#2 // if divisor = 2 -> add 1
add x13,x1,#1 // add 1
add x14,x1,#2 // else add 2
csel x1,x13,x14,eq
b 2b
/* divisor -> test if new dividende is prime */
7:
mov x3,x1 // save divisor
cmp x8,#1 // dividende = 1 ? -> end
beq 10f
mov x0,x8 // new dividende is prime ?
mov x1,#0
bl isPrime // the new dividende is prime ?
cmp x0,#1
bne 10f // the new dividende is not prime
cmp x8,x6 // else dividende is same divisor ?
beq 9f // yes
mov x7,x4 // number factors in table
mov x9,#0 // indice
71:
ldr x10,[x5,x9,lsl #3 ] // load one factor
mul x10,x8,x10 // multiply
str x10,[x5,x7,lsl #3] // and store in the table
adds x12,x12,x10
bcs 99f
add x7,x7,#1 // and increment counter
add x9,x9,#1
cmp x9,x4
blt 71b
mov x4,x7
mov x7,#0
b 11f
9:
sub x9,x4,#1
mov x7,x4
91:
ldr x10,[x5,x9,lsl #3 ]
cmp x10,x8
sub x13,x9,#1
csel x9,x13,x9,ne
bne 91b
sub x9,x4,x9
92:
ldr x10,[x5,x9,lsl #3 ]
mul x10,x8,x10
str x10,[x5,x7,lsl #3] // and store in the table
adds x12,x12,x10
bcs 99f // overflow
add x7,x7,#1 // and increment counter
add x9,x9,#1
cmp x9,x4
blt 92b
mov x4,x7
b 11f
10:
mov x1,x3 // current divisor = new divisor
cmp x1,x8 // current divisor > new dividende ?
ble 2b // no -> loop
/* end decomposition */
11:
mov x0,x4 // return number of table items
mov x1,x12 // return sum
mov x3,#0
str x3,[x5,x4,lsl #3] // store zéro in last table item
b 100f
98:
add x1,x8,1
mov x0,#0 // return code
b 100f
99:
ldr x0,qAdrszMessError
bl affichageMess
mov x0,#-1 // error code
b 100f
100:
ldp x10,x11,[sp],16 // restaur des 2 registres
ldp x8,x9,[sp],16 // restaur des 2 registres
ldp x6,x7,[sp],16 // restaur des 2 registres
ldp x4,x5,[sp],16 // restaur des 2 registres
ldp x3,lr,[sp],16 // restaur des 2 registres
ret // retour adresse lr x30
qAdrszMessErrGen: .quad szMessErrGen
/***************************************************/
/* Verification si un nombre est premier */
/***************************************************/
/* x0 contient le nombre à verifier */
/* x0 retourne 1 si premier 0 sinon */
isPrime:
stp x1,lr,[sp,-16]! // save registres
stp x2,x3,[sp,-16]! // save registres
mov x2,x0
sub x1,x0,#1
cmp x2,0
beq 99f // retourne zéro
cmp x2,2 // pour 1 et 2 retourne 1
ble 2f
mov x0,#2
bl moduloPux64
bcs 100f // erreur overflow
cmp x0,#1
bne 99f // Pas premier
cmp x2,3
beq 2f
mov x0,#3
bl moduloPux64
blt 100f // erreur overflow
cmp x0,#1
bne 99f
cmp x2,5
beq 2f
mov x0,#5
bl moduloPux64
bcs 100f // erreur overflow
cmp x0,#1
bne 99f // Pas premier
cmp x2,7
beq 2f
mov x0,#7
bl moduloPux64
bcs 100f // erreur overflow
cmp x0,#1
bne 99f // Pas premier
cmp x2,11
beq 2f
mov x0,#11
bl moduloPux64
bcs 100f // erreur overflow
cmp x0,#1
bne 99f // Pas premier
cmp x2,13
beq 2f
mov x0,#13
bl moduloPux64
bcs 100f // erreur overflow
cmp x0,#1
bne 99f // Pas premier
2:
cmn x0,0 // carry à zero pas d'erreur
mov x0,1 // premier
b 100f
99:
cmn x0,0 // carry à zero pas d'erreur
mov x0,#0 // Pas premier
100:
ldp x2,x3,[sp],16 // restaur des 2 registres
ldp x1,lr,[sp],16 // restaur des 2 registres
ret // retour adresse lr x30
/**************************************************************/
/********************************************************/
/* Calcul modulo de b puissance e modulo m */
/* Exemple 4 puissance 13 modulo 497 = 445 */
/********************************************************/
/* x0 nombre */
/* x1 exposant */
/* x2 modulo */
moduloPux64:
stp x1,lr,[sp,-16]! // save registres
stp x3,x4,[sp,-16]! // save registres
stp x5,x6,[sp,-16]! // save registres
stp x7,x8,[sp,-16]! // save registres
stp x9,x10,[sp,-16]! // save registres
cbz x0,100f
cbz x1,100f
mov x8,x0
mov x7,x1
mov x6,1 // resultat
udiv x4,x8,x2
msub x9,x4,x2,x8 // contient le reste
1:
tst x7,1
beq 2f
mul x4,x9,x6
umulh x5,x9,x6
mov x6,x4
mov x0,x6
mov x1,x5
bl divisionReg128U
cbnz x1,99f // overflow
mov x6,x3
2:
mul x8,x9,x9
umulh x5,x9,x9
mov x0,x8
mov x1,x5
bl divisionReg128U
cbnz x1,99f // overflow
mov x9,x3
lsr x7,x7,1
cbnz x7,1b
mov x0,x6 // result
cmn x0,0 // carry à zero pas d'erreur
b 100f
99:
ldr x0,qAdrszMessOverflow
bl affichageMess
cmp x0,0 // carry à un car erreur
mov x0,-1 // code erreur
100:
ldp x9,x10,[sp],16 // restaur des 2 registres
ldp x7,x8,[sp],16 // restaur des 2 registres
ldp x5,x6,[sp],16 // restaur des 2 registres
ldp x3,x4,[sp],16 // restaur des 2 registres
ldp x1,lr,[sp],16 // restaur des 2 registres
ret // retour adresse lr x30
qAdrszMessOverflow: .quad szMessOverflow
/***************************************************/
/* division d un nombre de 128 bits par un nombre de 64 bits */
/***************************************************/
/* x0 contient partie basse dividende */
/* x1 contient partie haute dividente */
/* x2 contient le diviseur */
/* x0 retourne partie basse quotient */
/* x1 retourne partie haute quotient */
/* x3 retourne le reste */
divisionReg128U:
stp x6,lr,[sp,-16]! // save registres
stp x4,x5,[sp,-16]! // save registres
mov x5,#0 // raz du reste R
mov x3,#128 // compteur de boucle
mov x4,#0 // dernier bit
1:
lsl x5,x5,#1 // on decale le reste de 1
tst x1,1<<63 // test du bit le plus à gauche
lsl x1,x1,#1 // on decale la partie haute du quotient de 1
beq 2f
orr x5,x5,#1 // et on le pousse dans le reste R
2:
tst x0,1<<63
lsl x0,x0,#1 // puis on decale la partie basse
beq 3f
orr x1,x1,#1 // et on pousse le bit de gauche dans la partie haute
3:
orr x0,x0,x4 // position du dernier bit du quotient
mov x4,#0 // raz du bit
cmp x5,x2
blt 4f
sub x5,x5,x2 // on enleve le diviseur du reste
mov x4,#1 // dernier bit à 1
4:
// et boucle
subs x3,x3,#1
bgt 1b
lsl x1,x1,#1 // on decale le quotient de 1
tst x0,1<<63
lsl x0,x0,#1 // puis on decale la partie basse
beq 5f
orr x1,x1,#1
5:
orr x0,x0,x4 // position du dernier bit du quotient
mov x3,x5
100:
ldp x4,x5,[sp],16 // restaur des 2 registres
ldp x6,lr,[sp],16 // restaur des 2 registres
ret // retour adresse lr x30
/********************************************************/
/* File Include fonctions */
/********************************************************/
/* for this file see task include a file in language AArch64 assembly */
.include "../includeARM64.inc"

106
Task/Aliquot-sequence-classifications/ALGOL-68/aliquot-sequence-classifications.alg Normal file
View file

@ -0,0 +1,106 @@
BEGIN
# aliquot sequence classification #
# maximum sequence length we consider #
INT max sequence length = 16;
# possible classifications #
STRING perfect classification = "perfect ";
STRING amicable classification = "amicable ";
STRING sociable classification = "sociable ";
STRING aspiring classification = "aspiring ";
STRING cyclic classification = "cyclic ";
STRING terminating classification = "terminating ";
STRING non terminating classification = "non terminating";
# structure to hold an aliquot sequence and its classification #
MODE ALIQUOT = STRUCT( STRING classification
, [ 1 : max sequence length ]LONG INT sequence
, INT length
);
# maximum value for sequence elements - if any element is more than this, #
# we assume it is non-teriminating #
LONG INT max element = 140 737 488 355 328;
# returns the sum of the proper divisors of n #
OP DIVISORSUM = ( LONG INT n )LONG INT:
BEGIN
LONG INT abs n = ABS n;
IF abs n < 2 THEN
0 # -1, 0 and 1 have no proper divisors #
ELSE
# have a number with possible divisors #
LONG INT result := 1; # 1 is always a divisor #
# a FOR loop counter can only be an INT, hence the WHILE loop #
LONG INT d := ENTIER long sqrt( abs n );
WHILE d > 1 DO
IF abs n MOD d = 0 THEN
# found another divisor #
result +:= d;
IF d * d /= abs n THEN
# add the other divisor #
result +:= abs n OVER d
FI
FI;
d -:= 1
OD;
result
FI
END # DIVISORSUM # ;
# generates the aliquot sequence of the number k and its classification #
# at most max elements of the sequence are considered #
OP CLASSIFY = ( LONG INT k )ALIQUOT :
BEGIN
ALIQUOT result;
classification OF result := "non-terminating";
INT lb = LWB sequence OF result;
INT ub = UPB sequence OF result;
( sequence OF result )[ lb ] := k; # the first element is always k #
length OF result := 1;
FOR i FROM lb + 1 TO ub DO
( sequence OF result )[ i ] := 0
OD;
BOOL classified := FALSE;
LONG INT prev k := k;
FOR i FROM lb + 1 TO ub WHILE NOT classified DO
length OF result +:= 1;
LONG INT next k := ( sequence OF result )[ i ] := DIVISORSUM prev k;
classified := TRUE;
IF next k = 0 THEN # the sequence terminates #
classification OF result := terminating classification
ELIF next k > max element THEN # the sequence gets too large #
classification OF result := non terminating classification
ELIF next k = k THEN # the sequence that returns to k #
classification OF result
:= IF i = lb + 1 THEN perfect classification
ELIF i = lb + 2 THEN amicable classification
ELSE sociable classification
FI
ELIF next k = prev k THEN # the sequence repeats with non-k #
classification OF result := aspiring classification
ELSE # check for repeating sequence with a period more than 1 #
classified := FALSE;
FOR prev pos FROM lb TO i - 2 WHILE NOT classified DO
IF classified := ( sequence OF result )[ prev pos ] = next k THEN
# found a repeatition #
classification OF result := cyclic classification
FI
OD
FI;
prev k := next k
OD;
result
END # CLASSIFY # ;
# test cases as per the task #
[]LONG INT test cases =
( 1, 2, 3, 4, 5, 6, 7, 8, 9, 10
, 11, 12, 28, 496, 220, 1184, 12496, 1264460, 790, 909
, 562, 1064, 1488
, 15355717786080
);
FOR i FROM LWB test cases TO UPB test cases DO
LONG INT k := test cases[ i ];
ALIQUOT seq = CLASSIFY k;
print( ( whole( k, -14 ), ": ", classification OF seq, ":" ) );
FOR e FROM LWB sequence OF seq + 1 TO length OF seq DO
print( ( " ", whole( ( sequence OF seq )[ e ], 0 ) ) )
OD;
print( ( newline ) )
OD
END

543
Task/Aliquot-sequence-classifications/ARM-Assembly/aliquot-sequence-classifications.arm Normal file
View file

@ -0,0 +1,543 @@
/* ARM assembly Raspberry PI */
/* program aliquotSeq.s */
/* REMARK 1 : this program use routines in a include file
see task Include a file language arm assembly
for the routine affichageMess conversion10
see at end of this program the instruction include */
/* for constantes see task include a file in arm assembly */
/************************************/
/* Constantes */
/************************************/
.include "../constantes.inc"
.equ MAXINUM, 10
.equ MAXI, 16
.equ NBDIVISORS, 1000
/*******************************************/
/* Initialized data */
/*******************************************/
.data
szMessStartPgm: .asciz "Program start \n"
szMessEndPgm: .asciz "Program normal end.\n"
szMessErrorArea: .asciz "\033[31mError : area divisors too small.\033[0m \n"
szMessError: .asciz "\033[31mError !!!\033[0m \n"
szMessErrGen: .asciz "Error end program.\033[0m \n"
szCarriageReturn: .asciz "\n"
szLibPerf: .asciz "Perfect \n"
szLibAmic: .asciz "Amicable \n"
szLibSoc: .asciz "Sociable \n"
szLibAspi: .asciz "Aspiring \n"
szLibCycl: .asciz "Cyclic \n"
szLibTerm: .asciz "Terminating \n"
szLibNoTerm: .asciz "No terminating\n"
/* datas message display */
szMessResult: .asciz " @ "
szMessResHead: .asciz "Number @ :"
.align 4
tbNumber: .int 11,12,28,496,220,1184,12496,1264460,790,909,562,1064,1488
.equ NBNUMBER, (. - tbNumber ) / 4
/*******************************************/
/* UnInitialized data */
/*******************************************/
.bss
.align 4
sZoneConv: .skip 24
tbZoneDecom: .skip 4 * NBDIVISORS // facteur 4 octets
tbNumberSucc: .skip 4 * MAXI
/*******************************************/
/* code section */
/*******************************************/
.text
.global main
main: @ program start
ldr r0,iAdrszMessStartPgm @ display start message
bl affichageMess
mov r4,#1
1:
mov r0,r4 @ number
bl aliquotClassif @ aliquot classification
cmp r0,#-1 @ error ?
beq 99f
add r4,r4,#1
cmp r4,#MAXINUM
ble 1b
ldr r5,iAdrtbNumber @ number array
mov r4,#0
2:
ldr r0,[r5,r4,lsl #2] @ load a number
bl aliquotClassif @ aliquot classification
cmp r0,#-1 @ error ?
beq 99f
add r4,r4,#1 @ next number
cmp r4,#NBNUMBER @ maxi ?
blt 2b @ no -> loop
ldr r0,iAdrszMessEndPgm @ display end message
bl affichageMess
b 100f
99: @ display error message
ldr r0,iAdrszMessError
bl affichageMess
100: @ standard end of the program
mov r0, #0 @ return code
mov r7, #EXIT @ request to exit program
svc 0 @ perform system call
iAdrszMessStartPgm: .int szMessStartPgm
iAdrszMessEndPgm: .int szMessEndPgm
iAdrszMessError: .int szMessError
iAdrszCarriageReturn: .int szCarriageReturn
iAdrtbZoneDecom: .int tbZoneDecom
iAdrszMessResult: .int szMessResult
iAdrsZoneConv: .int sZoneConv
iAdrtbNumber: .int tbNumber
/******************************************************************/
/* function aliquot classification */
/******************************************************************/
/* r0 contains number */
aliquotClassif:
push {r3-r8,lr} @ save registers
mov r5,r0 @ save number
ldr r1,iAdrsZoneConv
bl conversion10 @ convert ascii string
mov r2,#0
strb r2,[r1,r0]
ldr r0,iAdrszMessResHead
ldr r1,iAdrsZoneConv
bl strInsertAtCharInc @ put in head message
bl affichageMess @ and display
mov r0,r5 @ restaur number
ldr r7,iAdrtbNumberSucc @ number successif array
mov r4,#0 @ counter number successif
1:
mov r6,r0 @ previous number
ldr r1,iAdrtbZoneDecom
bl decompFact @ create area of divisors
cmp r0,#0 @ error ?
blt 99f
sub r3,r1,r6 @ sum
mov r0,r3
ldr r1,iAdrsZoneConv
bl conversion10 @ convert ascii string
mov r2,#0
strb r2,[r1,r0]
ldr r0,iAdrszMessResult
ldr r1,iAdrsZoneConv
bl strInsertAtCharInc @ and put in message
bl affichageMess
cmp r3,#0 @ sum = zero
bne 11f
ldr r0,iAdrszLibTerm @ terminating
bl affichageMess
b 100f
11:
cmp r5,r3 @ compare number and sum
bne 4f
cmp r4,#0 @ first loop ?
bne 2f
ldr r0,iAdrszLibPerf @ perfect
bl affichageMess
b 100f
2:
cmp r4,#1 @ second loop ?
bne 3f
ldr r0,iAdrszLibAmic @ amicable
bl affichageMess
b 100f
3: @ other loop
ldr r0,iAdrszLibSoc @ sociable
bl affichageMess
b 100f
4:
cmp r6,r3 @ compare sum and (sum - 1)
bne 5f
ldr r0,iAdrszLibAspi @ aspirant
bl affichageMess
b 100f
5:
cmp r3,#1 @ if one ,no search in array
beq 7f
mov r2,#0 @ search indice
6: @ search number in array
ldr r8,[r7,r2,lsl #2]
cmp r8,r3 @ equal ?
beq 8f @ yes -> cycling
add r2,r2,#1 @ increment indice
cmp r2,r4 @ end ?
blt 6b @ no -> loop
7:
cmp r4,#MAXI
blt 10f
ldr r0,iAdrszLibNoTerm @ no terminating
bl affichageMess
b 100f
8: @ cycling
ldr r0,iAdrszLibCycl
bl affichageMess
b 100f
10:
str r3,[r7,r4,lsl #2] @ store new sum in array
add r4,r4,#1 @ increment counter
mov r0,r3 @ new number = new sum
b 1b @ and loop
99: @ display error
ldr r0,iAdrszMessError
bl affichageMess
100:
pop {r3-r8,lr} @ restaur registers
bx lr
iAdrszMessResHead: .int szMessResHead
iAdrszLibPerf: .int szLibPerf
iAdrszLibAmic: .int szLibAmic
iAdrszLibSoc: .int szLibSoc
iAdrszLibCycl: .int szLibCycl
iAdrszLibAspi: .int szLibAspi
iAdrszLibNoTerm: .int szLibNoTerm
iAdrszLibTerm: .int szLibTerm
iAdrtbNumberSucc: .int tbNumberSucc
/******************************************************************/
/* factor decomposition */
/******************************************************************/
/* r0 contains number */
/* r1 contains address of divisors area */
/* r0 return divisors items in array */
/* r1 return the sum of divisors */
decompFact:
push {r3-r12,lr} @ save registers
cmp r0,#1
moveq r1,#1
beq 100f
mov r5,r1
mov r8,r0 @ save number
bl isPrime @ prime ?
cmp r0,#1
beq 98f @ yes is prime
mov r1,#1
str r1,[r5] @ first factor
mov r12,#1 @ divisors sum
mov r10,#1 @ indice divisors table
mov r9,#2 @ first divisor
mov r6,#0 @ previous divisor
mov r7,#0 @ number of same divisors
/* division loop */
2:
mov r0,r8 @ dividende
mov r1,r9 @ divisor
bl division @ r2 quotient r3 remainder
cmp r3,#0
beq 3f @ if remainder zero -> divisor
/* not divisor -> increment next divisor */
cmp r9,#2 @ if divisor = 2 -> add 1
addeq r9,#1
addne r9,#2 @ else add 2
b 2b
/* divisor compute the new factors of number */
3:
mov r8,r2 @ else quotient -> new dividende
cmp r9,r6 @ same divisor ?
beq 4f @ yes
mov r0,r5 @ table address
mov r1,r10 @ number factors in table
mov r2,r9 @ divisor
mov r3,r12 @ somme
mov r4,#0
bl computeFactors
cmp r0,#-1
beq 100f
mov r10,r1
mov r12,r0
mov r6,r9 @ new divisor
b 7f
4: @ same divisor
sub r7,r10,#1
5: @ search in table the first use of divisor
ldr r3,[r5,r7,lsl #2 ]
cmp r3,r9
subne r7,#1
bne 5b
@ and compute new factors after factors
sub r4,r10,r7 @ start indice
mov r0,r5
mov r1,r10
mov r2,r9 @ divisor
mov r3,r12
bl computeFactors
cmp r0,#-1
beq 100f
mov r12,r0
mov r10,r1
/* divisor -> test if new dividende is prime */
7:
cmp r8,#1 @ dividende = 1 ? -> end
beq 10f
mov r0,r8 @ new dividende is prime ?
mov r1,#0
bl isPrime @ the new dividende is prime ?
cmp r0,#1
bne 10f @ the new dividende is not prime
cmp r8,r6 @ else dividende is same divisor ?
beq 8f @ yes
mov r0,r5
mov r1,r10
mov r2,r8
mov r3,r12
mov r4,#0
bl computeFactors
cmp r0,#-1
beq 100f
mov r12,r0
mov r10,r1
mov r7,#0
b 11f
8:
sub r7,r10,#1
9:
ldr r3,[r5,r7,lsl #2 ]
cmp r3,r8
subne r7,#1
bne 9b
mov r0,r5
mov r1,r10
sub r4,r10,r7
mov r2,r8
mov r3,r12
bl computeFactors
cmp r0,#-1
beq 100f
mov r12,r0
mov r10,r1
b 11f
10:
cmp r9,r8 @ current divisor > new dividende ?
ble 2b @ no -> loop
/* end decomposition */
11:
mov r0,r10 @ return number of table items
mov r1,r12 @ return sum
mov r3,#0
str r3,[r5,r10,lsl #2] @ store zéro in last table item
b 100f
98: @ prime number
add r1,r8,#1
mov r0,#0 @ return code
b 100f
99:
ldr r0,iAdrszMessError
bl affichageMess
mov r0,#-1 @ error code
b 100f
100:
pop {r3-r12,pc} @ restaur registers
/******************************************************************/
/* compute all factors */
/******************************************************************/
/* r0 table factors address */
/* r1 number factors in table */
/* r2 new divisor */
/* r3 sum */
/* r4 start indice */
/* r0 return sum */
/* r1 return number factors in table */
computeFactors:
push {r2-r6,lr} @ save registers
mov r6,r1 @ number factors in table
1:
ldr r5,[r0,r4,lsl #2 ] @ load one factor
mul r5,r2,r5 @ multiply
str r5,[r0,r1,lsl #2] @ and store in the table
adds r3,r5
movcs r0,#-1 @ overflow
bcs 100f
add r1,r1,#1 @ and increment counter
add r4,r4,#1
cmp r4,r6
blt 1b
mov r0,r3 @ factors sum
100: @ fin standard de la fonction
pop {r2-r6,pc} @ restaur des registres
/***************************************************/
/* check if a number is prime */
/***************************************************/
/* r0 contains the number */
/* r0 return 1 if prime 0 else */
isPrime:
push {r1-r6,lr} @ save registers
cmp r0,#0
beq 90f
cmp r0,#17
bhi 1f
cmp r0,#3
bls 80f @ for 1,2,3 return prime
cmp r0,#5
beq 80f @ for 5 return prime
cmp r0,#7
beq 80f @ for 7 return prime
cmp r0,#11
beq 80f @ for 11 return prime
cmp r0,#13
beq 80f @ for 13 return prime
cmp r0,#17
beq 80f @ for 17 return prime
1:
tst r0,#1 @ even ?
beq 90f @ yes -> not prime
mov r2,r0 @ save number
sub r1,r0,#1 @ exposant n - 1
mov r0,#3 @ base
bl moduloPuR32 @ compute base power n - 1 modulo n
cmp r0,#1
bne 90f @ if <> 1 -> not prime
mov r0,#5
bl moduloPuR32
cmp r0,#1
bne 90f
mov r0,#7
bl moduloPuR32
cmp r0,#1
bne 90f
mov r0,#11
bl moduloPuR32
cmp r0,#1
bne 90f
mov r0,#13
bl moduloPuR32
cmp r0,#1
bne 90f
mov r0,#17
bl moduloPuR32
cmp r0,#1
bne 90f
80:
mov r0,#1 @ is prime
b 100f
90:
mov r0,#0 @ no prime
100: @ fin standard de la fonction
pop {r1-r6,pc} @ restaur des registres
/********************************************************/
/* Calcul modulo de b puissance e modulo m */
/* Exemple 4 puissance 13 modulo 497 = 445 */
/* */
/********************************************************/
/* r0 nombre */
/* r1 exposant */
/* r2 modulo */
/* r0 return result */
moduloPuR32:
push {r1-r7,lr} @ save registers
cmp r0,#0 @ verif <> zero
beq 100f
cmp r2,#0 @ verif <> zero
beq 100f @ TODO: v鲩fier les cas d erreur
1:
mov r4,r2 @ save modulo
mov r5,r1 @ save exposant
mov r6,r0 @ save base
mov r3,#1 @ start result
mov r1,#0 @ division de r0,r1 par r2
bl division32R
mov r6,r2 @ base <- remainder
2:
tst r5,#1 @ exposant even or odd
beq 3f
umull r0,r1,r6,r3
mov r2,r4
bl division32R
mov r3,r2 @ result <- remainder
3:
umull r0,r1,r6,r6
mov r2,r4
bl division32R
mov r6,r2 @ base <- remainder
lsr r5,#1 @ left shift 1 bit
cmp r5,#0 @ end ?
bne 2b
mov r0,r3
100: @ fin standard de la fonction
pop {r1-r7,pc} @ restaur des registres
/***************************************************/
/* division number 64 bits in 2 registers by number 32 bits */
/***************************************************/
/* r0 contains lower part dividende */
/* r1 contains upper part dividende */
/* r2 contains divisor */
/* r0 return lower part quotient */
/* r1 return upper part quotient */
/* r2 return remainder */
division32R:
push {r3-r9,lr} @ save registers
mov r6,#0 @ init upper upper part remainder !!
mov r7,r1 @ init upper part remainder with upper part dividende
mov r8,r0 @ init lower part remainder with lower part dividende
mov r9,#0 @ upper part quotient
mov r4,#0 @ lower part quotient
mov r5,#32 @ bits number
1: @ begin loop
lsl r6,#1 @ shift upper upper part remainder
lsls r7,#1 @ shift upper part remainder
orrcs r6,#1
lsls r8,#1 @ shift lower part remainder
orrcs r7,#1
lsls r4,#1 @ shift lower part quotient
lsl r9,#1 @ shift upper part quotient
orrcs r9,#1
@ divisor sustract upper part remainder
subs r7,r2
sbcs r6,#0 @ and substract carry
bmi 2f @ n駡tive ?
@ positive or equal
orr r4,#1 @ 1 -> right bit quotient
b 3f
2: @ negative
orr r4,#0 @ 0 -> right bit quotient
adds r7,r2 @ and restaur remainder
adc r6,#0
3:
subs r5,#1 @ decrement bit size
bgt 1b @ end ?
mov r0,r4 @ lower part quotient
mov r1,r9 @ upper part quotient
mov r2,r7 @ remainder
100: @ function end
pop {r3-r9,pc} @ restaur registers
/***************************************************/
/* ROUTINES INCLUDE */
/***************************************************/
.include "../affichage.inc"

66
Task/Aliquot-sequence-classifications/AWK/aliquot-sequence-classifications.awk Normal file
View file

@ -0,0 +1,66 @@
#!/bin/gawk -f
function sumprop(num, i,sum,root) {
if (num == 1) return 0
sum=1
root=sqrt(num)
for ( i=2; i < root; i++) {
if (num % i == 0 )
{
sum = sum + i + num/i
}
}
if (num % root == 0)
{
sum = sum + root
}
return sum
}
function class(k, oldk,newk,seq){
# first term
oldk = k
seq = " "
# second term
newk = sumprop(oldk)
oldk = newk
seq = seq " " newk
if (newk == 0) return "terminating " seq
if (newk == k) return "perfect " seq
# third term
newk = sumprop(oldk)
oldk = newk
seq = seq " " newk
if (newk == 0) return "terminating " seq
if (newk == k) return "amicable " seq
for (t=4; t<17; t++) {
newk = sumprop(oldk)
seq = seq " " newk
if (newk == 0) return "terminating " seq
if (newk == k) return "sociable (period " t-1 ") "seq
if (newk == oldk) return "aspiring " seq
if (index(seq," " newk " ") > 0) return "cyclic (at " newk ") " seq
if (newk > 140737488355328) return "non-terminating (term > 140737488355328) " seq
oldk = newk
}
return "non-terminating (after 16 terms) " seq
}
BEGIN{
print "Number classification sequence"
for (j=1; j < 11; j++)
{
print j,class(j)}
print 11,class(11)
print 12,class(12)
print 28,class(28)
print 496,class(496)
print 220,class(220)
print 1184,class(1184)
print 12496,class(12496)
print 1264460,class(1264460)
print 790,class(790)
print 909,class(909)
print 562,class(562)
print 1064,class(1064)
print 1488,class(1488)
print 15355717786080,class(15355717786080)
}

69
Task/Aliquot-sequence-classifications/AppleScript/aliquot-sequence-classifications-1.applescript Normal file
View file

@ -0,0 +1,69 @@
on aliquotSum(n)
if (n < 2) then return 0
set sum to 1
set sqrt to n ^ 0.5
set limit to sqrt div 1
if (limit = sqrt) then
set sum to sum + limit
set limit to limit - 1
end if
repeat with i from 2 to limit
if (n mod i is 0) then set sum to sum + i + n div i
end repeat
return sum
end aliquotSum
on aliquotSequence(k, maxLength, maxN)
-- Generate the sequence within the specified limitations.
set sequence to {k}
set n to k
repeat (maxLength - 1) times
set n to aliquotSum(n)
set repetition to (sequence contains n)
if (repetition) then exit repeat
set end of sequence to n
if ((n = 0) or (n > maxN)) then exit repeat
end repeat
-- Analyse it.
set sequenceLength to (count sequence)
if (sequenceLength is 1) then
set classification to "perfect"
else if (n is 0) then
set classification to "terminating"
else if (n = k) then
if (sequenceLength is 2) then
set classification to "amicable"
else
set classification to "sociable"
end if
else if (repetition) then
if (sequence ends with n) then
set classification to "aspiring"
else
set classification to "cyclic"
end if
else
set classification to "non-terminating"
end if
return {sequence:sequence, classification:classification}
end aliquotSequence
-- Task code:
local output, maxLength, maxN, spacing, astid, k
set output to {""}
set {maxLength, maxN} to {16, 2 ^ 47}
set spacing to " "
set astid to AppleScript's text item delimiters
set AppleScript's text item delimiters to ", "
repeat with k in {1, 2, 3, 4, 5, 6, 7, 8, 9, 10, ¬
11, 12, 28, 496, 220, 1184, 12496, 1264460, 790, 909, 562, 1064, 1488, 1.535571778608E+13}
set thisResult to aliquotSequence(k's contents, maxLength, maxN)
set end of output to text -18 thru -1 of (spacing & k) & ": " & ¬
text 1 thru 17 of (thisResult's classification & spacing) & thisResult's sequence
end repeat
set AppleScript's text item delimiters to linefeed
set output to output as text
set AppleScript's text item delimiters to astid
return output

25
Task/Aliquot-sequence-classifications/AppleScript/aliquot-sequence-classifications-2.applescript Normal file
View file

@ -0,0 +1,25 @@
"
1: terminating 1, 0
2: terminating 2, 1, 0
3: terminating 3, 1, 0
4: terminating 4, 3, 1, 0
5: terminating 5, 1, 0
6: perfect 6
7: terminating 7, 1, 0
8: terminating 8, 7, 1, 0
9: terminating 9, 4, 3, 1, 0
10: terminating 10, 8, 7, 1, 0
11: terminating 11, 1, 0
12: terminating 12, 16, 15, 9, 4, 3, 1, 0
28: perfect 28
496: perfect 496
220: amicable 220, 284
1184: amicable 1184, 1210
12496: sociable 12496, 14288, 15472, 14536, 14264
1264460: sociable 1264460, 1547860, 1727636, 1305184
790: aspiring 790, 650, 652, 496
909: aspiring 909, 417, 143, 25, 6
562: cyclic 562, 284, 220
1064: cyclic 1064, 1336, 1184, 1210
1488: non-terminating 1488, 2480, 3472, 4464, 8432, 9424, 10416, 21328, 22320, 55056, 95728, 96720, 236592, 459792, 881392, 882384
1.535571778608E+13: non-terminating 1.535571778608E+13, 4.453466360112E+13, 1.449400874645E+14"

52
Task/Aliquot-sequence-classifications/BASIC256/aliquot-sequence-classifications.basic Normal file
View file

@ -0,0 +1,52 @@
# Rosetta Code problem: http://rosettacode.org/wiki/Aliquot_sequence_classifications
# by Jjuanhdez, 06/2022
global limite
limite = 20000000
dim nums = {1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 28, 496, 220, 1184, 12496, 1264460, 790, 909, 562, 1064, 1488}
for n = 0 to nums[?]-1
print "Number "; nums[n]; " : ";
call PrintAliquotClassifier(nums[n])
next n
print
print "Program normal end."
end
function PDtotal (n)
total = 0
for y = 2 to n
if (n mod y) = 0 then total += (n / y)
next y
return total
end function
subroutine PrintAliquotClassifier (K)
longit = 52: n = K: clase = 0: priorn = 0: inc = 0
dim Aseq(longit)
for element = 2 to longit
Aseq[element] = PDtotal(n)
n = int(Aseq[element])
print n; " ";
begin case
case n = 0
print " Terminating": clase = 1: exit for
case n = K and element = 2
print " Perfect" : clase = 2: exit for
case n = K and element = 3
print " Amicable": clase = 3: exit for
case n = K and element > 3
print " Sociable": clase = 4: exit for
case n <> K and Aseq[element - 1] = Aseq[element]
print " Aspiring": clase = 5: exit for
case n <> K and Aseq[element - 2] = n
print " Cyclic": clase = 6: exit for
end case
if n > priorn then priorn = n: inc += 1 else inc = 0: priorn = 0
if inc = 11 or n > limite then exit for
next element
if clase = 0 then print " non-terminating"
end subroutine

70
Task/Aliquot-sequence-classifications/C++/aliquot-sequence-classifications.cpp Normal file
View file

@ -0,0 +1,70 @@
#include <cstdint>
#include <iostream>
#include <string>
using integer = uint64_t;
// See https://en.wikipedia.org/wiki/Divisor_function
integer divisor_sum(integer n) {
integer total = 1, power = 2;
// Deal with powers of 2 first
for (; n % 2 == 0; power *= 2, n /= 2)
total += power;
// Odd prime factors up to the square root
for (integer p = 3; p * p <= n; p += 2) {
integer sum = 1;
for (power = p; n % p == 0; power *= p, n /= p)
sum += power;
total *= sum;
}
// If n > 1 then it's prime
if (n > 1)
total *= n + 1;
return total;
}
// See https://en.wikipedia.org/wiki/Aliquot_sequence
void classify_aliquot_sequence(integer n) {
constexpr int limit = 16;
integer terms[limit];
terms[0] = n;
std::string classification("non-terminating");
int length = 1;
for (int i = 1; i < limit; ++i) {
++length;
terms[i] = divisor_sum(terms[i - 1]) - terms[i - 1];
if (terms[i] == n) {
classification =
(i == 1 ? "perfect" : (i == 2 ? "amicable" : "sociable"));
break;
}
int j = 1;
for (; j < i; ++j) {
if (terms[i] == terms[i - j])
break;
}
if (j < i) {
classification = (j == 1 ? "aspiring" : "cyclic");
break;
}
if (terms[i] == 0) {
classification = "terminating";
break;
}
}
std::cout << n << ": " << classification << ", sequence: " << terms[0];
for (int i = 1; i < length && terms[i] != terms[i - 1]; ++i)
std::cout << ' ' << terms[i];
std::cout << '\n';
}
int main() {
for (integer i = 1; i <= 10; ++i)
classify_aliquot_sequence(i);
for (integer i : {11, 12, 28, 496, 220, 1184, 12496, 1264460, 790, 909, 562,
1064, 1488})
classify_aliquot_sequence(i);
classify_aliquot_sequence(15355717786080);
classify_aliquot_sequence(153557177860800);
return 0;
}

71
Task/Aliquot-sequence-classifications/C/aliquot-sequence-classifications-1.c Normal file
View file

@ -0,0 +1,71 @@
#include<stdlib.h>
#include<string.h>
#include<stdio.h>
unsigned long long bruteForceProperDivisorSum(unsigned long long n){
unsigned long long i,sum = 0;
for(i=1;i<(n+1)/2;i++)
if(n%i==0 && n!=i)
sum += i;
return sum;
}
void printSeries(unsigned long long* arr,int size,char* type){
int i;
printf("\nInteger : %llu, Type : %s, Series : ",arr[0],type);
for(i=0;i<size-1;i++)
printf("%llu, ",arr[i]);
printf("%llu",arr[i]);
}
void aliquotClassifier(unsigned long long n){
unsigned long long arr[16];
int i,j;
arr[0] = n;
for(i=1;i<16;i++){
arr[i] = bruteForceProperDivisorSum(arr[i-1]);
if(arr[i]==0||arr[i]==n||(arr[i]==arr[i-1] && arr[i]!=n)){
printSeries(arr,i+1,(arr[i]==0)?"Terminating":(arr[i]==n && i==1)?"Perfect":(arr[i]==n && i==2)?"Amicable":(arr[i]==arr[i-1] && arr[i]!=n)?"Aspiring":"Sociable");
return;
}
for(j=1;j<i;j++){
if(arr[j]==arr[i]){
printSeries(arr,i+1,"Cyclic");
return;
}
}
}
printSeries(arr,i+1,"Non-Terminating");
}
void processFile(char* fileName){
FILE* fp = fopen(fileName,"r");
char str[21];
while(fgets(str,21,fp)!=NULL)
aliquotClassifier(strtoull(str,(char**)NULL,10));
fclose(fp);
}
int main(int argC,char* argV[])
{
if(argC!=2)
printf("Usage : %s <positive integer>",argV[0]);
else{
if(strchr(argV[1],'.')!=NULL)
processFile(argV[1]);
else
aliquotClassifier(strtoull(argV[1],(char**)NULL,10));
}
return 0;
}

101
Task/Aliquot-sequence-classifications/C/aliquot-sequence-classifications-2.c Normal file
View file

@ -0,0 +1,101 @@
#include<string.h>
#include<stdlib.h>
#include<stdio.h>
unsigned long long raiseTo(unsigned long long base, unsigned long long power){
unsigned long long result = 1,i;
for (i=0; i<power;i++) {
result*=base;
}
return result;
}
unsigned long long properDivisorSum(unsigned long long n){
unsigned long long prod = 1;
unsigned long long temp = n,i,count = 0;
while(n%2 == 0){
count++;
n /= 2;
}
if(count!=0)
prod *= (raiseTo(2,count + 1) - 1);
for(i=3;i*i<=n;i+=2){
count = 0;
while(n%i == 0){
count++;
n /= i;
}
if(count==1)
prod *= (i+1);
else if(count > 1)
prod *= ((raiseTo(i,count + 1) - 1)/(i-1));
}
if(n>2)
prod *= (n+1);
return prod - temp;
}
void printSeries(unsigned long long* arr,int size,char* type){
int i;
printf("\nInteger : %llu, Type : %s, Series : ",arr[0],type);
for(i=0;i<size-1;i++)
printf("%llu, ",arr[i]);
printf("%llu",arr[i]);
}
void aliquotClassifier(unsigned long long n){
unsigned long long arr[16];
int i,j;
arr[0] = n;
for(i=1;i<16;i++){
arr[i] = properDivisorSum(arr[i-1]);
if(arr[i]==0||arr[i]==n||(arr[i]==arr[i-1] && arr[i]!=n)){
printSeries(arr,i+1,(arr[i]==0)?"Terminating":(arr[i]==n && i==1)?"Perfect":(arr[i]==n && i==2)?"Amicable":(arr[i]==arr[i-1] && arr[i]!=n)?"Aspiring":"Sociable");
return;
}
for(j=1;j<i;j++){
if(arr[j]==arr[i]){
printSeries(arr,i+1,"Cyclic");
return;
}
}
}
printSeries(arr,i+1,"Non-Terminating");
}
void processFile(char* fileName){
FILE* fp = fopen(fileName,"r");
char str[21];
while(fgets(str,21,fp)!=NULL)
aliquotClassifier(strtoull(str,(char**)NULL,10));
fclose(fp);
}
int main(int argC,char* argV[])
{
if(argC!=2)
printf("Usage : %s <positive integer>",argV[0]);
else{
if(strchr(argV[1],'.')!=NULL)
processFile(argV[1]);
else
aliquotClassifier(strtoull(argV[1],(char**)NULL,10));
}
return 0;
}

96
Task/Aliquot-sequence-classifications/CLU/aliquot-sequence-classifications.clu Normal file
View file

@ -0,0 +1,96 @@
% This program uses the 'bigint' cluster from PCLU's 'misc.lib'
% Remove leading and trailing whitespace (bigint$unparse adds a lot)
strip = proc (s: string) returns (string)
ac = array[char]
sc = sequence[char]
cs: ac := string$s2ac(s)
while ~ac$empty(cs) cand ac$bottom(cs)=' ' do ac$reml(cs) end
while ~ac$empty(cs) cand ac$top(cs)=' ' do ac$remh(cs) end
% There's a bug in ac2s that makes it not return all elements
% This is a workaround
return(string$sc2s(sc$a2s(cs)))
end strip
divisor_sum = proc (n: bigint) returns (bigint)
own zero: bigint := bigint$i2bi(0)
own one: bigint := bigint$i2bi(1)
own two: bigint := bigint$i2bi(2)
own three: bigint := bigint$i2bi(3)
total: bigint := one
power: bigint := two
while n//two=zero do
total := total + power
power := power * two
n := n / two
end
p: bigint := three
while p*p <= n do
sum: bigint := one
power := p
while n//p = zero do
sum := sum + power
power := power * p
n := n/p
end
total := total * sum
p := p + two
end
if n>one then total := total * (n+one) end
return(total)
end divisor_sum
classify_aliquot_sequence = proc (n: bigint)
LIMIT = 16
abi = array[bigint]
own zero: bigint := bigint$i2bi(0)
po: stream := stream$primary_output()
terms: array[bigint] := abi$predict(0,LIMIT)
abi$addh(terms, n)
classification: string := "non-terminating"
for i: int in int$from_to(1, limit-1) do
abi$addh(terms, divisor_sum(abi$top(terms)) - abi$top(terms))
if abi$top(terms) = n then
if i=1 then classification := "perfect"
elseif i=2 then classification := "amicable"
else classification := "sociable"
end
break
end
j: int := 1
while j<i cand terms[i] ~= terms[i-j] do j := j+1 end
if j<i then
if j=1 then classification := "aspiring"
else classification := "cyclic"
end
break
end
if abi$top(terms) = zero then
classification := "terminating"
break
end
end
stream$puts(po, strip(bigint$unparse(n)) || ": " || classification || ", sequence: "
|| strip(bigint$unparse(terms[0])))
for i: int in int$from_to(1, abi$high(terms)) do
if terms[i] = terms[i-1] then break end
stream$puts(po, " " || strip(bigint$unparse(terms[i])))
end
stream$putl(po, "")
end classify_aliquot_sequence
start_up = proc ()
for i: int in int$from_to(1, 10) do
classify_aliquot_sequence(bigint$i2bi(i))
end
for i: int in array[int]$elements(array[int]$
[11,12,28,496,220,1184,12496,1264460,790,909,562,1064,1488]) do
classify_aliquot_sequence(bigint$i2bi(i))
end
classify_aliquot_sequence(bigint$parse("15355717786080"))
classify_aliquot_sequence(bigint$parse("153557177860800"))
end start_up

67
Task/Aliquot-sequence-classifications/Common-Lisp/aliquot-sequence-classifications.lisp Normal file
View file

@ -0,0 +1,67 @@
(defparameter *nlimit* 16)
(defparameter *klimit* (expt 2 47))
(defparameter *asht* (make-hash-table))
(load "proper-divisors")
(defun ht-insert (v n)
(setf (gethash v *asht*) n))
(defun ht-find (v n)
(let ((nprev (gethash v *asht*)))
(if nprev (- n nprev) nil)))
(defun ht-list ()
(defun sort-keys (&optional (res '()))
(maphash #'(lambda (k v) (push (cons k v) res)) *asht*)
(sort (copy-list res) #'< :key (lambda (p) (cdr p))))
(let ((sorted (sort-keys)))
(dotimes (i (length sorted)) (format t "~A " (car (nth i sorted))))))
(defun aliquot-generator (K1)
"integer->function::fn to generate aliquot sequence"
(let ((Kn K1))
#'(lambda () (setf Kn (reduce #'+ (proper-divisors-recursive Kn) :initial-value 0)))))
(defun aliquot (K1)
"integer->symbol|nil::classify aliquot sequence"
(defun aliquot-sym (Kn n)
(let* ((period (ht-find Kn n))
(sym (if period
(cond ; period event
((= Kn K1)
(case period (1 'PERF) (2 'AMIC) (otherwise 'SOCI)))
((= period 1) 'ASPI)
(t 'CYCL))
(cond ; else check for limit event
((= Kn 0) 'TERM)
((> Kn *klimit*) 'TLIM)
((= n *nlimit*) 'NLIM)
(t nil)))))
;; if period event store the period, if no event insert the value
(if sym (when period (setf (symbol-plist sym) (list period)))
(ht-insert Kn n))
sym))
(defun aliquot-str (sym &optional (period 0))
(case sym (TERM "terminating") (PERF "perfect") (AMIC "amicable") (ASPI "aspiring")
(SOCI (format nil "sociable (period ~A)" (car (symbol-plist sym))))
(CYCL (format nil "cyclic (period ~A)" (car (symbol-plist sym))))
(NLIM (format nil "non-terminating (no classification before added term limit of ~A)" *nlimit*))
(TLIM (format nil "non-terminating (term threshold of ~A exceeded)" *klimit*))
(otherwise "unknown")))
(clrhash *asht*)
(let ((fgen (aliquot-generator K1)))
(setf (symbol-function 'aliseq) #'(lambda () (funcall fgen))))
(ht-insert K1 0)
(do* ((n 1 (1+ n))
(Kn (aliseq) (aliseq))
(alisym (aliquot-sym Kn n) (aliquot-sym Kn n)))
(alisym (format t "~A:" (aliquot-str alisym)) (ht-list) (format t "~A~%" Kn) alisym)))
(defun main ()
(princ "The last item in each sequence triggers classification.") (terpri)
(dotimes (k 10)
(aliquot (+ k 1)))
(dolist (k '(11 12 28 496 220 1184 12496 1264460 790 909 562 1064 1488 15355717786080))
(aliquot k)))

51
Task/Aliquot-sequence-classifications/D/aliquot-sequence-classifications.d Normal file
View file

@ -0,0 +1,51 @@
import std.stdio, std.range, std.algorithm, std.typecons, std.conv;
auto properDivisors(in ulong n) pure nothrow @safe /*@nogc*/ {
return iota(1UL, (n + 1) / 2 + 1).filter!(x => n % x == 0 && n != x);
}
enum pDivsSum = (in ulong n) pure nothrow @safe /*@nogc*/ =>
n.properDivisors.sum;
auto aliquot(in ulong n,
in size_t maxLen=16,
in ulong maxTerm=2UL^^47) pure nothrow @safe {
if (n == 0)
return tuple("Terminating", [0UL]);
ulong[] s = [n];
size_t sLen = 1;
ulong newN = n;
while (sLen <= maxLen && newN < maxTerm) {
newN = s.back.pDivsSum;
if (s.canFind(newN)) {
if (s[0] == newN) {
if (sLen == 1) {
return tuple("Perfect", s);
} else if (sLen == 2) {
return tuple("Amicable", s);
} else
return tuple(text("Sociable of length ", sLen), s);
} else if (s.back == newN) {
return tuple("Aspiring", s);
} else
return tuple(text("Cyclic back to ", newN), s);
} else if (newN == 0) {
return tuple("Terminating", s ~ 0);
} else {
s ~= newN;
sLen++;
}
}
return tuple("Non-terminating", s);
}
void main() {
foreach (immutable n; 1 .. 11)
writefln("%s: %s", n.aliquot[]);
writeln;
foreach (immutable n; [11, 12, 28, 496, 220, 1184, 12496, 1264460,
790, 909, 562, 1064, 1488])
writefln("%s: %s", n.aliquot[]);
}

54
Task/Aliquot-sequence-classifications/EchoLisp/aliquot-sequence-classifications-1.l Normal file
View file

@ -0,0 +1,54 @@
;; implementation of Floyd algorithm to find cycles in a graph
;; see Wikipedia https://en.wikipedia.org/wiki/Cycle_detection
;; returns (cycle-length cycle-starter steps)
;; steps = 0 if no cycle found
;; it's all about a tortoise 🐢 running at speed f(x) after a hare 🐰 at speed f(f (x))
;; when they meet, a cycle is found
(define (floyd f x0 steps maxvalue)
(define lam 1) ; cycle length
(define tortoise (f x0))
(define hare (f (f x0)))
;; cyclic ? yes if steps > 0
(while (and (!= tortoise hare) (> steps 0))
(set!-values (tortoise hare) (values (f tortoise) (f (f hare))))
#:break (and (> hare maxvalue) (set! steps 0))
(set! steps (1- steps)))
;; first repetition = cycle starter
(set! tortoise x0)
(while (and (!= tortoise hare) (> steps 0))
(set!-values (tortoise hare) (values (f tortoise) (f hare))))
;; length of shortest cycle
(set! hare (f tortoise))
(while (and (!= tortoise hare) (> steps 0))
(set! hare (f hare))
(set! lam (1+ lam)))
(values lam tortoise steps))
;; find cycle and classify
(define (taxonomy n (steps 16) (maxvalue 140737488355328))
(define-values (cycle starter steps) (floyd sum-divisors n steps maxvalue))
(write n
(cond
(( = steps 0) 'non-terminating)
(( = starter 0) 'terminating)
((and (= starter n) (= cycle 1)) 'perfect)
((and (= starter n) (= cycle 2)) 'amicable)
((= starter n) 'sociable )
((= cycle 1) 'aspiring )
(else 'cyclic)))
(aliquote n starter)
)
;; print sequence
(define (aliquote x0 (starter -1) (end -1 )(n 8))
(for ((i n))
(write x0)
(set! x0 (sum-divisors x0))
#:break (and (= x0 end) (write x0))
(when (= x0 starter) (set! end starter)))
(writeln ...))

39
Task/Aliquot-sequence-classifications/EchoLisp/aliquot-sequence-classifications-2.l Normal file
View file

@ -0,0 +1,39 @@
(lib 'math)
(lib 'bigint)
(for-each taxonomy (range 1 13))
1 terminating 1 0 0 ...
2 terminating 2 1 0 0 ...
3 terminating 3 1 0 0 ...
4 terminating 4 3 1 0 0 ...
5 terminating 5 1 0 0 ...
6 perfect 6 6 6 ...
7 terminating 7 1 0 0 ...
8 terminating 8 7 1 0 0 ...
9 terminating 9 4 3 1 0 0 ...
10 terminating 10 8 7 1 0 0 ...
11 terminating 11 1 0 0 ...
12 terminating 12 16 15 9 4 3 1 0 0 ...
(for-each taxonomy '( 28 496 220 1184 12496 1264460 790 909 562 1064 1488 15355717786080))
28 perfect 28 28 28 ...
496 perfect 496 496 496 ...
220 amicable 220 284 220 284 220 ...
1184 amicable 1184 1210 1184 1210 1184 ...
12496 sociable 12496 14288 15472 14536 14264 12496 14288 15472 ...
1264460 sociable 1264460 1547860 1727636 1305184 1264460 1547860 1727636 1305184 1264460 ...
790 aspiring 790 650 652 496 496 ...
909 aspiring 909 417 143 25 6 6 ...
562 cyclic 562 284 220 284 ...
1064 cyclic 1064 1336 1184 1210 1184 ...
1488 non-terminating 1488 2480 3472 4464 8432 9424 10416 21328 ...
15355717786080 non-terminating 15355717786080 44534663601120 144940087464480 471714103310688 1130798979186912 2688948041357088 6050151708497568 13613157922639968 ...
(taxonomy 1000) ;; 1000 non-terminating after 16 steps
1000 non-terminating 1000 1340 1516 1144 1376 1396 1054 674 ...
(taxonomy 1000 32) ;; but terminating if we increase the number of steps
1000 terminating
1000 1340 1516 1144 1376 1396 1054 674 340 416 466 236 184 176 196 203 37 1 0 0 ...

50
Task/Aliquot-sequence-classifications/Elixir/aliquot-sequence-classifications.elixir Normal file
View file

@ -0,0 +1,50 @@
defmodule Proper do
def divisors(1), do: []
def divisors(n), do: [1 | divisors(2,n,:math.sqrt(n))] |> Enum.sort
defp divisors(k,_n,q) when k>q, do: []
defp divisors(k,n,q) when rem(n,k)>0, do: divisors(k+1,n,q)
defp divisors(k,n,q) when k * k == n, do: [k | divisors(k+1,n,q)]
defp divisors(k,n,q) , do: [k,div(n,k) | divisors(k+1,n,q)]
end
defmodule Aliquot do
def sequence(n, maxlen\\16, maxterm\\140737488355328)
def sequence(0, _maxlen, _maxterm), do: "terminating"
def sequence(n, maxlen, maxterm) do
{msg, s} = sequence(n, maxlen, maxterm, [n])
{msg, Enum.reverse(s)}
end
defp sequence(n, maxlen, maxterm, s) when length(s) < maxlen and n < maxterm do
m = Proper.divisors(n) |> Enum.sum
cond do
m in s ->
case {m, List.last(s), hd(s)} do
{x,x,_} ->
case length(s) do
1 -> {"perfect", s}
2 -> {"amicable", s}
_ -> {"sociable of length #{length(s)}", s}
end
{x,_,x} -> {"aspiring", [m | s]}
_ -> {"cyclic back to #{m}", [m | s]}
end
m == 0 -> {"terminating", [0 | s]}
true -> sequence(m, maxlen, maxterm, [m | s])
end
end
defp sequence(_, _, _, s), do: {"non-terminating", s}
end
Enum.each(1..10, fn n ->
{msg, s} = Aliquot.sequence(n)
:io.fwrite("~7w:~21s: ~p~n", [n, msg, s])
end)
IO.puts ""
[11, 12, 28, 496, 220, 1184, 12496, 1264460, 790, 909, 562, 1064, 1488, 15355717786080]
|> Enum.each(fn n ->
{msg, s} = Aliquot.sequence(n)
if n<10000000, do: :io.fwrite("~7w:~21s: ~p~n", [n, msg, s]),
else: :io.fwrite("~w: ~s: ~p~n", [n, msg, s])
end)

54
Task/Aliquot-sequence-classifications/Factor/aliquot-sequence-classifications.factor Normal file
View file

@ -0,0 +1,54 @@
USING: combinators combinators.short-circuit formatting kernel
literals locals math math.functions math.primes.factors
math.ranges namespaces pair-rocket sequences sets ;
FROM: namespaces => set ;
IN: rosetta-code.aliquot
SYMBOL: terms
CONSTANT: 2^47 $[ 2 47 ^ ]
CONSTANT: test-cases {
11 12 28 496 220 1184 12496 1264460 790
909 562 1064 1488 15355717786080
}
: next-term ( n -- m ) dup divisors sum swap - ;
: continue-aliquot? ( hs term -- hs term ? )
{
[ terms get 15 < ]
[ swap in? not ]
[ nip zero? not ]
[ nip 2^47 < ]
} 2&& ;
: next-aliquot ( hs term -- hs next-term term )
[ swap [ adjoin ] keep ]
[ dup [ next-term ] dip ] bi terms inc ;
: aliquot ( k -- seq )
0 terms set HS{ } clone swap
[ continue-aliquot? ] [ next-aliquot ] produce
[ drop ] 2dip swap suffix ;
: non-terminating? ( seq -- ? )
{ [ length 15 > ] [ [ 2^47 > ] any? ] } 1|| ;
:: classify ( seq -- classification-str )
{
[ seq non-terminating? ] => [ "non-terminating" ]
[ seq last zero? ] => [ "terminating" ]
[ seq length 2 = ] => [ "perfect" ]
[ seq length 3 = ] => [ "amicable" ]
[ seq first seq last = ] => [ "sociable" ]
[ seq 2 tail* first2 = ] => [ "aspiring" ]
[ "cyclic" ]
} cond ;
: .classify ( k -- )
dup aliquot [ classify ] keep "%14u: %15s: %[%d, %]\n"
printf ;
: main ( -- )
10 [1,b] test-cases append [ .classify ] each ;
MAIN: main

123
Task/Aliquot-sequence-classifications/Fortran/aliquot-sequence-classifications.f Normal file
View file

@ -0,0 +1,123 @@
MODULE FACTORSTUFF !This protocol evades the need for multiple parameters, or COMMON, or one shapeless main line...
Concocted by R.N.McLean, MMXV.
c INTEGER*4 I4LIMIT
c PARAMETER (I4LIMIT = 2147483647)
INTEGER*8 TOOBIG !Some bounds.
PARAMETER (TOOBIG = 2**47) !Computer arithmetic is not with real numbers.
INTEGER LOTS !Nor is computer storage infinite.
PARAMETER (LOTS = 10000) !So there can't be all that many of these.
INTEGER*8 KNOWNSUM(LOTS) !If multiple references are expected, it is worthwhile calculating these.
CONTAINS !Assistants.
INTEGER*8 FUNCTION SUMF(N) !Sum of the proper divisors of N.
INTEGER*8 N !The number in question.
INTEGER*8 F,F2 !Candidate factor, and its square.
INTEGER*8 S,INC,BOOST !Assistants.
IF (N.LE.LOTS) THEN !If we're within reach,
SUMF = KNOWNSUM(N) !The result is to hand.
ELSE !Otherwise, some on-the-spot effort ensues.
Could use SUMF in place of S, but some compilers have been confused by such usage.
S = 1 !1 is always a factor of N, but N is deemed not proper.
F = 1 !Prepare a crude search for factors.
INC = 1 !One by plodding one.
IF (MOD(N,2) .EQ. 1) INC = 2!Ah, but an odd number cannot have an even number as a divisor.
1 F = F + INC !So half the time we can doubleplod.
F2 = F*F !Up to F2 < N rather than F < SQRT(N) and worries over inexact arithmetic.
IF (F2 .LT. N) THEN !F2 = N handled below.
IF (MOD(N,F) .EQ. 0) THEN !Does F divide N?
BOOST = F + N/F !Yes. The divisor and its counterpart.
IF (S .GT. TOOBIG - BOOST) GO TO 666 !Would their augmentation cause an overflow?
S = S + BOOST !No, so count in the two divisors just discovered.
END IF !So much for a divisor discovered.
GO TO 1 !Try for another.
END IF !So much for N = p*q style factors.
IF (F2 .EQ. N) THEN !Special case: N may be a perfect square, not necessarily of a prime number.
IF (S .GT. TOOBIG - F) GO TO 666 !It is. And it too might cause overflow.
S = S + F !But if not, count F once only.
END IF !All done.
SUMF = S !This is the result.
END IF !Whichever way obtained,
RETURN !Done.
Cannot calculate the sum, because it exceeds the INTEGER*8 limit.
666 SUMF = -666 !An expression of dismay that the caller will notice.
END FUNCTION SUMF !Alternatively, find the prime factors, and combine them...
SUBROUTINE PREPARESUMF !Initialise the KNOWNSUM array.
Convert the Sieve of Eratoshenes to have each slot contain the sum of the proper divisors of its slot number.
Changes to instead count the number of factors, or prime factors, etc. would be simple enough.
INTEGER*8 F !A factor for numbers such as 2F, 3F, 4F, 5F, ...
KNOWNSUM(1) = 0 !Proper divisors of N do not include N.
KNOWNSUM(2:LOTS) = 1 !So, although 1 divides all N without remainder, 1 is excluded for itself.
DO F = 2,LOTS/2 !Step through all the possible divisors of numbers not exceeding LOTS.
FORALL(I = F + F:LOTS:F) KNOWNSUM(I) = KNOWNSUM(I) + F !And augment each corresponding slot.
END DO !Different divisors can hit the same slot. For instance, 6 by 2 and also by 3.
END SUBROUTINE PREPARESUMF !Could alternatively generate all products of prime numbers.
SUBROUTINE CLASSIFY(N) !Traipse along the SumF trail.
INTEGER*8 N !The starter.
INTEGER ROPE !The size of my memory is not so great..
PARAMETER(ROPE = 16) !Indeed, this is strictly limited.
INTEGER*8 TRAIL(ROPE) !But the numbers can be large.
INTEGER*8 SF !The working sum of proper divisors.
INTEGER I,L !Indices, merely.
CHARACTER*28 THIS !A perfect scratchpad for remarks.
L = 1 !Every journey starts with its first step.
TRAIL(1) = N !Which is this.
SF = N !Syncopation.
10 SF = SUMF(SF) !Step onwards.
IF (SF .LT. 0) THEN !Trouble?
WRITE (THIS,11) L,"overflows!" !Yes. Too big a number.
11 FORMAT ("After ",I0,", ",A) !Describe the situation.
CALL REPORT(ADJUSTR(THIS)) !And give the report.
ELSE IF (SF .EQ. 0) THEN !Otherwise, a finish?
WRITE (THIS,11) L,"terminates!" !Yay!
CALL REPORT(ADJUSTR(THIS)) !This sequence is finished.
ELSE IF (ANY(TRAIL(1:L) .EQ. SF)) THEN !Otherwise, is there an echo somewhere?
IF (L .EQ. 1) THEN !Yes!
CALL REPORT("Perfect!") !Are we at the start?
ELSE IF (L .EQ. 2) THEN !Or perhaps not far along.
CALL REPORT("Amicable:") !These are held special.
ELSE !Otherwise, we've wandered further along.
I = MINLOC(ABS(TRAIL(1:L) - SF),DIM=1) !Damnit, re-scan the array to finger the first matching element.
IF (I .EQ. 1) THEN !If all the way back to the start,
WRITE (THIS,12) L !Then there are this many elements in the sociable ring.
12 FORMAT ("Sociable ",I0,":") !Computers are good at counting.
CALL REPORT(ADJUSTR(THIS)) !So, perform an added service.
ELSE IF (I .EQ. L) THEN !Perhaps we've hit a perfect number!
CALL REPORT("Aspiring:") !A cycle of length one.
ELSE !But otherwise,
WRITE (THIS,13) L - I + 1,SF !A longer cycle. Amicable, or sociable.
13 FORMAT ("Cyclic end ",I0,", to ",I0,":") !Name the flashback value too.
CALL REPORT(ADJUSTR(THIS)) !Thus.
END IF !So much for cycles.
END IF !So much for finding an echo.
ELSE !Otherwise, nothing special has happened.
IF (L .GE. ROPE) THEN !So, how long is a piece of string?
WRITE (THIS,11) L,"non-terminating?" !Not long enough!
CALL REPORT(ADJUSTR(THIS)) !So we give up.
ELSE !But if there is more scope,
L = L + 1 !Advance one more step.
TRAIL(L) = SF !Save the latest result.
GO TO 10 !And try for the next.
END IF !So much for continuing.
END IF !So much for the classification.
RETURN !Finished.
CONTAINS !Not quite.
SUBROUTINE REPORT(WHAT) !There is this service routine.
CHARACTER*(*) WHAT !Whatever the length of the text, the FORMAT's A28 shows 28 characters, right-aligned.
WRITE (6,1) WHAT,TRAIL(1:L)!Mysteriously, a fresh line after every twelve elements.
1 FORMAT (A28,1X,12(I0:",")) !And obviously, the : signifies "do not print what follows unless there is another number to go.
END SUBROUTINE REPORT !That was easy.
END SUBROUTINE CLASSIFY !Enough.
END MODULE FACTORSTUFF !Enough assistants.
PROGRAM CLASSIFYTHEM !Report on the nature of the sequence N, Sumf(N), Sumf(Sumf(N)), etc.
USE FACTORSTUFF !This should help.
INTEGER*8 I,N !Steppers.
INTEGER*8 THIS(14) !A testing collection.
DATA THIS/11,12,28,496,220,1184,12496,1264460,790,909, !Old-style continuation character in column six.
1 562,1064,1488,15355717786080/ !Monster value far exceeds the INTEGER*4 limit
CALL PREPARESUMF !Prepare for 1:LOTS, even though this test run will use only a few.
DO I = 1,10 !As specified, the first ten integers.
CALL CLASSIFY(I)
END DO
DO I = 1,SIZE(THIS) !Now for the specified list.
CALL CLASSIFY(THIS(I))
END DO
END !Done.

79
Task/Aliquot-sequence-classifications/FreeBASIC/aliquot-sequence-classifications.basic Normal file
View file

@ -0,0 +1,79 @@
function raiseTo( bas as ulongint, power as ulongint ) as ulongint
dim as ulongint result = 1, i
for i = 1 to power
result*=bas
next i
return result
end function
function properDivisorSum( n as ulongint ) as ulongint
dim as ulongint prod = 1, temp = n, i = 3, count = 0
while n mod 2 = 0
count += 1
n /= 2
wend
if count<>0 then prod *= (raiseTo(2,count + 1) - 1)
while i*i <= n
count = 0
while n mod i = 0
count += 1
n /= i
wend
if count = 1 then
prod *= (i+1)
elseif count > 1 then
prod *= ((raiseTo(i,count + 1) - 1)/(i-1))
end if
i += 2
wend
if n>2 then prod *= (n+1)
return prod - temp
end function
sub printSeries( arr() as ulongint ptr, size as integer, ty as string)
dim as integer i
dim as string outstr = "Integer: "+str(arr(0))+", Type: "+ty+", Series: "
for i=0 to size-2
outstr = outstr + str(arr(i))+", "
next i
outstr = outstr + str(arr(i))
print outstr
end sub
sub aliquotClassifier(n as ulongint)
dim as ulongint arr(0 to 15)
dim as integer i, j
dim as string ty = "Sociable"
arr(0) = n
for i = 1 to 15
arr(i) = properDivisorSum(arr(i-1))
if arr(i)=0 orelse arr(i)=n orelse (arr(i) = arr(i-1) and arr(i)<>n) then
if arr(i) = 0 then
ty = "Terminating"
elseif arr(i) = n and i = 1 then
ty = "Perfect"
elseif arr(i) = n and i = 2 then
ty = "Amicable"
elseif arr(i) = arr(i-1) and arr(i)<>n then
ty = "Aspiring"
end if
printSeries(arr(),i+1,ty)
return
end if
for j = 1 to i-1
if arr(j) = arr(i) then
printSeries(arr(),i+1,"Cyclic")
return
end if
next j
next i
printSeries(arr(),i+1,"Non-Terminating")
end sub
dim as ulongint nums(0 to 22) = {_
1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 28, 496, 220, 1184,_
12496, 1264460, 790, 909, 562, 1064, 1488}
for n as ubyte = 0 to 22
aliquotClassifier(nums(n))
next n

109
Task/Aliquot-sequence-classifications/Go/aliquot-sequence-classifications.go Normal file
View file

@ -0,0 +1,109 @@
package main
import (
"fmt"
"math"
"strings"
)
const threshold = uint64(1) << 47
func indexOf(s []uint64, search uint64) int {
for i, e := range s {
if e == search {
return i
}
}
return -1
}
func contains(s []uint64, search uint64) bool {
return indexOf(s, search) > -1
}
func maxOf(i1, i2 int) int {
if i1 > i2 {
return i1
}
return i2
}
func sumProperDivisors(n uint64) uint64 {
if n < 2 {
return 0
}
sqrt := uint64(math.Sqrt(float64(n)))
sum := uint64(1)
for i := uint64(2); i <= sqrt; i++ {
if n % i != 0 {
continue
}
sum += i + n / i
}
if sqrt * sqrt == n {
sum -= sqrt
}
return sum
}
func classifySequence(k uint64) ([]uint64, string) {
if k == 0 {
panic("Argument must be positive.")
}
last := k
var seq []uint64
seq = append(seq, k)
for {
last = sumProperDivisors(last)
seq = append(seq, last)
n := len(seq)
aliquot := ""
switch {
case last == 0:
aliquot = "Terminating"
case n == 2 && last == k:
aliquot = "Perfect"
case n == 3 && last == k:
aliquot = "Amicable"
case n >= 4 && last == k:
aliquot = fmt.Sprintf("Sociable[%d]", n - 1)
case last == seq[n - 2]:
aliquot = "Aspiring"
case contains(seq[1 : maxOf(1, n - 2)], last):
aliquot = fmt.Sprintf("Cyclic[%d]", n - 1 - indexOf(seq[:], last))
case n == 16 || last > threshold:
aliquot = "Non-Terminating"
}
if aliquot != "" {
return seq, aliquot
}
}
}
func joinWithCommas(seq []uint64) string {
res := fmt.Sprint(seq)
res = strings.Replace(res, " ", ", ", -1)
return res
}
func main() {
fmt.Println("Aliquot classifications - periods for Sociable/Cyclic in square brackets:\n")
for k := uint64(1); k <= 10; k++ {
seq, aliquot := classifySequence(k)
fmt.Printf("%2d: %-15s %s\n", k, aliquot, joinWithCommas(seq))
}
fmt.Println()
s := []uint64{
11, 12, 28, 496, 220, 1184, 12496, 1264460, 790, 909, 562, 1064, 1488,
}
for _, k := range s {
seq, aliquot := classifySequence(k)
fmt.Printf("%7d: %-15s %s\n", k, aliquot, joinWithCommas(seq))
}
fmt.Println()
k := uint64(15355717786080)
seq, aliquot := classifySequence(k)
fmt.Printf("%d: %-15s %s\n", k, aliquot, joinWithCommas(seq))
}

41
Task/Aliquot-sequence-classifications/Haskell/aliquot-sequence-classifications.hs Normal file
View file

@ -0,0 +1,41 @@
divisors :: (Integral a) => a -> [a]
divisors n = filter ((0 ==) . (n `mod`)) [1 .. (n `div` 2)]
data Class
= Terminating
| Perfect
| Amicable
| Sociable
| Aspiring
| Cyclic
| Nonterminating
deriving (Show)
aliquot :: (Integral a) => a -> [a]
aliquot 0 = [0]
aliquot n = n : (aliquot $ sum $ divisors n)
classify :: (Num a, Eq a) => [a] -> Class
classify [] = Nonterminating
classify [0] = Terminating
classify [_] = Nonterminating
classify [a,b]
| a == b = Perfect
| b == 0 = Terminating
| otherwise = Nonterminating
classify x@(a:b:c:_)
| a == b = Perfect
| a == c = Amicable
| a `elem` (drop 1 x) = Sociable
| otherwise =
case classify (drop 1 x) of
Perfect -> Aspiring
Amicable -> Cyclic
Sociable -> Cyclic
d -> d
main :: IO ()
main = do
let cls n = let ali = take 16 $ aliquot n in (classify ali, ali)
mapM_ (print . cls) $ [1..10] ++
[11, 12, 28, 496, 220, 1184, 12496, 1264460, 790, 909, 562, 1064, 1488]

15
Task/Aliquot-sequence-classifications/J/aliquot-sequence-classifications-1.j Normal file
View file

@ -0,0 +1,15 @@
proper_divisors=: [: */@>@}:@,@{ [: (^ i.@>:)&.>/ 2 p: x:
aliquot=: +/@proper_divisors ::0:
rc_aliquot_sequence=: aliquot^:(i.16)&>
rc_classify=: 3 :0
if. 16 ~:# y do. ' invalid '
elseif. 6 > {: y do. ' terminate '
elseif. (+./y>2^47) +. 16 = #~.y do. ' non-terminating'
elseif. 1=#~. y do. ' perfect '
elseif. 8= st=. {.#/.~ y do. ' amicable '
elseif. 1 < st do. ' sociable '
elseif. =/_2{. y do. ' aspiring '
elseif. 1 do. ' cyclic '
end.
)
rc_display_aliquot_sequence=: (rc_classify,' ',":)@:rc_aliquot_sequence

27
Task/Aliquot-sequence-classifications/J/aliquot-sequence-classifications-2.j Normal file
View file

@ -0,0 +1,27 @@
rc_display_aliquot_sequence&> >: i.10
terminate 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
terminate 2 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0
terminate 3 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0
terminate 4 3 1 0 0 0 0 0 0 0 0 0 0 0 0 0
terminate 5 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0
perfect 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6
terminate 7 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0
terminate 8 7 1 0 0 0 0 0 0 0 0 0 0 0 0 0
terminate 9 4 3 1 0 0 0 0 0 0 0 0 0 0 0 0
terminate 10 8 7 1 0 0 0 0 0 0 0 0 0 0 0 0
rc_display_aliquot_sequence&>11, 12, 28, 496, 220, 1184, 12496, 1264460, 790, 909, 562, 1064, 1488, 15355717786080x
terminate 11 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0
terminate 12 16 15 9 4 3 1 0 0 0 0 0 0 0 0 0
perfect 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28
perfect 496 496 496 496 496 496 496 496 496 496 496 496 496 496 496 496
amicable 220 284 220 284 220 284 220 284 220 284 220 284 220 284 220 284
amicable 1184 1210 1184 1210 1184 1210 1184 1210 1184 1210 1184 1210 1184 1210 1184 1210
sociable 12496 14288 15472 14536 14264 12496 14288 15472 14536 14264 12496 14288 15472 14536 14264 12496
sociable 1264460 1547860 1727636 1305184 1264460 1547860 1727636 1305184 1264460 1547860 1727636 1305184 1264460 1547860 1727636 1305184
aspiring 790 650 652 496 496 496 496 496 496 496 496 496 496 496 496 496
aspiring 909 417 143 25 6 6 6 6 6 6 6 6 6 6 6 6
cyclic 562 284 220 284 220 284 220 284 220 284 220 284 220 284 220 284
cyclic 1064 1336 1184 1210 1184 1210 1184 1210 1184 1210 1184 1210 1184 1210 1184 1210
non-terminating 1488 2480 3472 4464 8432 9424 10416 21328 22320 55056 95728 96720 236592 459792 881392 882384
non-terminating 15355717786080 44534663601120 144940087464480 471714103310688 1130798979186912 2688948041357088 6050151708497568 13613157922639968 35513546724070632 74727605255142168 162658586225561832 353930992506879768 642678347124409032 1125102611548462968 1977286128289819992 3415126495450394808

64
Task/Aliquot-sequence-classifications/Java/aliquot-sequence-classifications.java Normal file
View file

@ -0,0 +1,64 @@
import java.util.ArrayList;
import java.util.Arrays;
import java.util.List;
import java.util.stream.LongStream;
public class AliquotSequenceClassifications {
private static Long properDivsSum(long n) {
return LongStream.rangeClosed(1, (n + 1) / 2).filter(i -> n % i == 0 && n != i).sum();
}
static boolean aliquot(long n, int maxLen, long maxTerm) {
List<Long> s = new ArrayList<>(maxLen);
s.add(n);
long newN = n;
while (s.size() <= maxLen && newN < maxTerm) {
newN = properDivsSum(s.get(s.size() - 1));
if (s.contains(newN)) {
if (s.get(0) == newN) {
switch (s.size()) {
case 1:
return report("Perfect", s);
case 2:
return report("Amicable", s);
default:
return report("Sociable of length " + s.size(), s);
}
} else if (s.get(s.size() - 1) == 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 boolean report(String msg, List<Long> result) {
System.out.println(msg + ": " + result);
return false;
}
public static void main(String[] args) {
long[] arr = {
11, 12, 28, 496, 220, 1184, 12496, 1264460,
790, 909, 562, 1064, 1488};
LongStream.rangeClosed(1, 10).forEach(n -> aliquot(n, 16, 1L << 47));
System.out.println();
Arrays.stream(arr).forEach(n -> aliquot(n, 16, 1L << 47));
}
}

59
Task/Aliquot-sequence-classifications/Jq/aliquot-sequence-classifications-1.jq Normal file
View file

@ -0,0 +1,59 @@
# "until" is available in more recent versions of jq
# than jq 1.4
def until(cond; next):
def _until:
if cond then . else (next|_until) end;
_until;
# unordered
def proper_divisors:
. as $n
| if $n > 1 then 1,
( range(2; 1 + (sqrt|floor)) as $i
| if ($n % $i) == 0 then $i,
(($n / $i) | if . == $i then empty else . end)
else empty
end)
else empty
end;
# sum of proper divisors, or 0
def pdsum:
[proper_divisors] | add // 0;
# input is n
# maxlen defaults to 16;
# maxterm defaults to 2^47
def aliquot(maxlen; maxterm):
(maxlen // 15) as $maxlen
| (maxterm // 40737488355328) as $maxterm
| if . == 0 then "terminating at 0"
else
# [s, slen, new] = [[n], 1, n]
[ [.], 1, .]
| until( type == "string" or .[1] > $maxlen or .[2] > $maxterm;
.[0] as $s | .[1] as $slen
| ($s | .[length-1] | pdsum) as $new
| if ($s|index($new)) then
if $s[0] == $new then
if $slen == 1 then "perfect \($s)"
elif $slen == 2 then "amicable: \($s)"
else "sociable of length \($slen): \($s)"
end
elif ($s | .[length-1]) == $new then "aspiring: \($s)"
else "cyclic back to \($new): \($s)"
end
elif $new == 0 then "terminating: \($s + [0])"
else [ ($s + [$new]), ($slen + 1), $new ]
end )
| if type == "string" then . else "non-terminating: \(.[0])" end
end;
def task:
def pp: "\(.): \(aliquot(null;null))";
(range(1; 11) | pp),
"",
((11, 12, 28, 496, 220, 1184, 12496, 1264460,
790, 909, 562, 1064, 1488, 15355717786080) | pp);
task

26
Task/Aliquot-sequence-classifications/Jq/aliquot-sequence-classifications-2.jq Normal file
View file

@ -0,0 +1,26 @@
$ jq -n -r -f aliquot.jq
1: terminating: [1,0]
2: terminating: [2,1,0]
3: terminating: [3,1,0]
4: terminating: [4,3,1,0]
5: terminating: [5,1,0]
6: perfect [6]
7: terminating: [7,1,0]
8: terminating: [8,7,1,0]
9: terminating: [9,4,3,1,0]
10: terminating: [10,8,7,1,0]
11: terminating: [11,1,0]
12: terminating: [12,16,15,9,4,3,1,0]
28: perfect [28]
496: perfect [496]
220: amicable: [220,284]
1184: amicable: [1184,1210]
12496: sociable of length 5: [12496,14288,15472,14536,14264]
1264460: sociable of length 4: [1264460,1547860,1727636,1305184]
790: aspiring: [790,650,652,496]
909: aspiring: [909,417,143,25,6]
562: cyclic back to 284: [562,284,220]
1064: cyclic back to 1184: [1064,1336,1184,1210]
1488: non-terminating: [1488,2480,3472,4464,8432,9424,10416,21328,22320,55056,95728,96720,236592,459792,881392,882384]
15355717786080: non-terminating: [15355717786080,44534663601120]

24
Task/Aliquot-sequence-classifications/Julia/aliquot-sequence-classifications-1.julia Normal file
View file

@ -0,0 +1,24 @@
function aliquotclassifier{T<:Integer}(n::T)
a = T[n]
b = divisorsum(a[end])
len = 1
while len < 17 && !(b in a) && 0 < b && b < 2^47+1
push!(a, b)
b = divisorsum(a[end])
len += 1
end
if b in a
1 < len || return ("Perfect", a)
if b == a[1]
2 < len || return ("Amicable", a)
return ("Sociable", a)
elseif b == a[end]
return ("Aspiring", a)
else
return ("Cyclic", push!(a, b))
end
end
push!(a, b)
b != 0 || return ("Terminating", a)
return ("Non-terminating", a)
end

17
Task/Aliquot-sequence-classifications/Julia/aliquot-sequence-classifications-2.julia Normal file
View file

@ -0,0 +1,17 @@
function pcontrib{T<:Integer}(p::T, a::T)
n = one(T)
pcon = one(T)
for i in 1:a
n *= p
pcon += n
end
return pcon
end
function divisorsum{T<:Integer}(n::T)
dsum = one(T)
for (p, a) in factor(n)
dsum *= pcontrib(p, a)
end
dsum -= n
end

8
Task/Aliquot-sequence-classifications/Julia/aliquot-sequence-classifications-3.julia Normal file
View file

@ -0,0 +1,8 @@
using Printf
println("Classification Tests:")
tests = [1:12, 28, 496, 220, 1184, 12496, 1264460, 790, 909, 562, 1064, 1488]
for i in tests
(class, a) = aliquotclassifier(i)
println(@sprintf("%8d => ", i), @sprintf("%16s, ", class), a)
end

62
Task/Aliquot-sequence-classifications/Kotlin/aliquot-sequence-classifications.kotlin Normal file
View file

@ -0,0 +1,62 @@
// version 1.1.3
data class Classification(val sequence: List<Long>, val aliquot: String)
const val THRESHOLD = 1L shl 47
fun sumProperDivisors(n: Long): Long {
if (n < 2L) return 0L
val sqrt = Math.sqrt(n.toDouble()).toLong()
var sum = 1L + (2L..sqrt)
.filter { n % it == 0L }
.map { it + n / it }
.sum()
if (sqrt * sqrt == n) sum -= sqrt
return sum
}
fun classifySequence(k: Long): Classification {
require(k > 0)
var last = k
val seq = mutableListOf(k)
while (true) {
last = sumProperDivisors(last)
seq.add(last)
val n = seq.size
val aliquot = when {
last == 0L -> "Terminating"
n == 2 && last == k -> "Perfect"
n == 3 && last == k -> "Amicable"
n >= 4 && last == k -> "Sociable[${n - 1}]"
last == seq[n - 2] -> "Aspiring"
last in seq.slice(1..n - 3) -> "Cyclic[${n - 1 - seq.indexOf(last)}]"
n == 16 || last > THRESHOLD -> "Non-Terminating"
else -> ""
}
if (aliquot != "") return Classification(seq, aliquot)
}
}
fun main(args: Array<String>) {
println("Aliqot classifications - periods for Sociable/Cyclic in square brackets:\n")
for (k in 1L..10) {
val (seq, aliquot) = classifySequence(k)
println("${"%2d".format(k)}: ${aliquot.padEnd(15)} $seq")
}
val la = longArrayOf(
11, 12, 28, 496, 220, 1184, 12496, 1264460, 790, 909, 562, 1064, 1488
)
println()
for (k in la) {
val (seq, aliquot) = classifySequence(k)
println("${"%7d".format(k)}: ${aliquot.padEnd(15)} $seq")
}
println()
val k = 15355717786080L
val (seq, aliquot) = classifySequence(k)
println("$k: ${aliquot.padEnd(15)} $seq")
}

44
Task/Aliquot-sequence-classifications/Liberty-BASIC/aliquot-sequence-classifications.basic Normal file
View file

@ -0,0 +1,44 @@
print "ROSETTA CODE - Aliquot sequence classifications"
[Start]
input "Enter an integer: "; K
K=abs(int(K)): if K=0 then goto [Quit]
call PrintAS K
goto [Start]
[Quit]
print "Program complete."
end
sub PrintAS K
Length=52
dim Aseq(Length)
n=K: class=0
for element=2 to Length
Aseq(element)=PDtotal(n)
print Aseq(element); " ";
select case
case Aseq(element)=0
print " terminating": class=1: exit for
case Aseq(element)=K and element=2
print " perfect": class=2: exit for
case Aseq(element)=K and element=3
print " amicable": class=3: exit for
case Aseq(element)=K and element>3
print " sociable": class=4: exit for
case Aseq(element)<>K and Aseq(element-1)=Aseq(element)
print " aspiring": class=5: exit for
case Aseq(element)<>K and Aseq(element-2)= Aseq(element)
print " cyclic": class=6: exit for
end select
n=Aseq(element)
if n>priorn then priorn=n: inc=inc+1 else inc=0: priorn=0
if inc=11 or n>30000000 then exit for
next element
if class=0 then print " non-terminating"
end sub
function PDtotal(n)
for y=2 to n
if (n mod y)=0 then PDtotal=PDtotal+(n/y)
next
end function

19
Task/Aliquot-sequence-classifications/Mathematica/aliquot-sequence-classifications.math Normal file
View file

@ -0,0 +1,19 @@
seq[n_] :=
NestList[If[# == 0, 0,
DivisorSum[#, # &, Function[div, div != #]]] &, n, 16];
class[seq_] :=
Which[Length[seq] < 2, "Non-terminating", MemberQ[seq, 0],
"Terminating", seq[[1]] == seq[[2]], "Perfect",
Length[seq] > 2 && seq[[1]] == seq[[3]], "Amicable",
Length[seq] > 3 && MemberQ[seq[[4 ;;]], seq[[1]]], "Sociable",
MatchQ[class[Rest[seq]], "Perfect" | "Aspiring"], "Aspiring",
MatchQ[class[Rest[seq]], "Amicable" | "Sociable" | "Cyclic"],
"Cyclic", True, "Non-terminating"];
notate[seq_] :=
Which[seq == {}, {},
MemberQ[Rest[seq],
seq[[1]]], {Prepend[TakeWhile[Rest[seq], # != seq[[1]] &],
seq[[1]]]}, True, Prepend[notate[Rest[seq]], seq[[1]]]];
Print[{#, class[seq[#]], notate[seq[#]] /. {0} -> 0}] & /@ {1, 2, 3, 4, 5, 6, 7,
8, 9, 10, 11, 12, 28, 496, 220, 1184, 12496, 1264460, 790, 909,
562, 1064, 1488, 15355717786080};

98
Task/Aliquot-sequence-classifications/Nim/aliquot-sequence-classifications.nim Normal file
View file

@ -0,0 +1,98 @@
import std/[math, strformat, times]
from std/strutils import addSep
type
# Classification categories.
Category {.pure.} = enum
Unknown
Terminating = "terminating"
Perfect = "perfect"
Amicable = "amicable"
Sociable = "sociable"
Aspiring = "aspiring"
Cyclic = "cyclic"
NonTerminating = "non-terminating"
# Aliquot sequence.
AliquotSeq = seq[int64]
const Limit = 2^47 # Limit beyond which the category is considered to be "NonTerminating".
#---------------------------------------------------------------------------------------------------
proc sumProperDivisors(n: int64): int64 =
## Compute the sum of proper divisors.*
if n == 1: return 0
result = 1
for d in 2..sqrt(n.float).int:
if n mod d == 0:
inc result, d
if n div d != d:
result += n div d
#---------------------------------------------------------------------------------------------------
iterator aliquotSeq(n: int64): int64 =
## Yield the elements of the aliquot sequence of "n".
## Stopped if the current value is null or equal to "n".
var k = n
while true:
k = sumProperDivisors(k)
yield k
#---------------------------------------------------------------------------------------------------
proc `$`(a: AliquotSeq): string =
## Return the representation of an allquot sequence.
for n in a:
result.addSep(", ", 0)
result.addInt(n)
#---------------------------------------------------------------------------------------------------
proc classification(n: int64): tuple[cat: Category, values: AliquotSeq] =
## Return the category of the aliquot sequence of a number "n" and the sequence itself.
var count = 0 # Number of elements currently generated.
var prev = n # Previous element in the sequence.
result.cat = Unknown
for k in aliquotSeq(n):
inc count
if k == 0:
result.cat = Terminating
elif k == n:
result.cat = case count
of 1: Perfect
of 2: Amicable
else: Sociable
elif k > Limit or count > 16:
result.cat = NonTerminating
elif k == prev:
result.cat = Aspiring
elif k in result.values:
result.cat = Cyclic
prev = k
result.values.add(k)
if result.cat != Unknown:
break
#---------------------------------------------------------------------------------------------------
let t0 = getTime()
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]:
let (cat, aseq) = classification(n)
echo fmt"{n:14}: {cat:<20} {aseq}"
echo ""
echo fmt"Processed in {(getTime() - t0).inMilliseconds} ms."

37
Task/Aliquot-sequence-classifications/Oforth/aliquot-sequence-classifications.fth Normal file
View file

@ -0,0 +1,37 @@
import: mapping
import: quicksort
import: math
Object method: sum ( coll -- m )
#+ self reduce dup ifNull: [ drop 0 ] ;
Integer method: properDivs
| i l |
Array new dup 1 over add ->l
2 self nsqrt tuck for: i [ self i mod ifFalse: [ i l add self i / l add ] ]
sq self == ifTrue: [ l pop drop ]
dup sort
;
: aliquot( n -- [] ) \ Returns aliquot sequence of n
| end l |
2 47 pow ->end
Array new dup n over add ->l
while ( l size 16 < l last 0 <> and l last end <= and ) [ l last properDivs sum l add ]
;
: aliquotClass( n -- [] s ) \ Returns aliquot sequence and classification
| l i j |
n aliquot dup ->l
l last 0 == ifTrue: [ "terminate" return ]
l second n == ifTrue: [ "perfect" return ]
3 l at n == ifTrue: [ "amicable" return ]
l indexOfFrom(n, 2) ifNotNull: [ "sociable" return ]
l size loop: i [
l indexOfFrom(l at(i), i 1+ ) -> j
j i 1+ == ifTrue: [ "aspiring" return ]
j ifNotNull: [ "cyclic" return ]
]
"non-terminating"
;

18
Task/Aliquot-sequence-classifications/PARI-GP/aliquot-sequence-classifications.parigp Normal file
View file

@ -0,0 +1,18 @@
aliquot(x) =
{
my (L = List(x), M = Map(Mat([x,1])), k, m = "non-term.", n = x);
for (i = 2, 16, n = vecsum(divisors(n)) - n;
if (n > 2^47, break,
n == 0, m = "terminates"; break,
mapisdefined(M, n, &k),
m = if (k == 1,
if (i == 2, "perfect",
i == 3, "amicable",
i > 3, concat("sociable-",i-1)),
k < i-1, concat("cyclic-",i-k),
"aspiring"); break,
mapput(M, n, i); listput(L, n));
);
printf("%16d: %10s, %s\n", x, m, Vec(L));
}

36
Task/Aliquot-sequence-classifications/Perl/aliquot-sequence-classifications.pl Normal file
View file

@ -0,0 +1,36 @@
use ntheory qw/divisor_sum/;
sub aliquot {
my($n, $maxterms, $maxn) = @_;
$maxterms = 16 unless defined $maxterms;
$maxn = 2**47 unless defined $maxn;
my %terms = ($n => 1);
my @allterms = ($n);
for my $term (2 .. $maxterms) {
$n = divisor_sum($n)-$n;
# push onto allterms here if we want the cyclic term to display
last if $n > $maxn;
return ("terminates",@allterms, 0) if $n == 0;
if (defined $terms{$n}) {
return ("perfect",@allterms) if $term == 2 && $terms{$n} == 1;
return ("amicible",@allterms) if $term == 3 && $terms{$n} == 1;
return ("sociable-".($term-1),@allterms) if $term > 3 && $terms{$n} == 1;
return ("aspiring",@allterms) if $terms{$n} == $term-1;
return ("cyclic-".($term-$terms{$n}),@allterms) if $terms{$n} < $term-1;
}
$terms{$n} = $term;
push @allterms, $n;
}
("non-term",@allterms);
}
for my $n (1..10) {
my($class, @seq) = aliquot($n);
printf "%14d %10s [@seq]\n", $n, $class;
}
print "\n";
for my $n (qw/11 12 28 496 220 1184 12496 1264460 790 909 562 1064 1488 15355717786080/) {
my($class, @seq) = aliquot($n);
printf "%14d %10s [@seq]\n", $n, $class;
}

30
Task/Aliquot-sequence-classifications/Phix/aliquot-sequence-classifications.phix Normal file
View file

@ -0,0 +1,30 @@
-->
<span style="color: #008080;">function</span> <span style="color: #000000;">aliquot</span><span style="color: #0000FF;">(</span><span style="color: #004080;">atom</span> <span style="color: #000000;">n</span><span style="color: #0000FF;">)</span>
<span style="color: #004080;">sequence</span> <span style="color: #000000;">s</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">n</span><span style="color: #0000FF;">}</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">k</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">n</span><span style="color: #0000FF;">=</span><span style="color: #000000;">0</span> <span style="color: #008080;">then</span> <span style="color: #008080;">return</span> <span style="color: #0000FF;">{</span><span style="color: #008000;">"terminating"</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">0</span><span style="color: #0000FF;">}}</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">while</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">s</span><span style="color: #0000FF;">)<</span><span style="color: #000000;">16</span>
<span style="color: #008080;">and</span> <span style="color: #000000;">n</span><span style="color: #0000FF;"><</span><span style="color: #000000;">140737488355328</span> <span style="color: #008080;">do</span>
<span style="color: #000000;">n</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">sum</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">factors</span><span style="color: #0000FF;">(</span><span style="color: #000000;">n</span><span style="color: #0000FF;">,-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">))</span>
<span style="color: #000000;">k</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">find</span><span style="color: #0000FF;">(</span><span style="color: #000000;">n</span><span style="color: #0000FF;">,</span><span style="color: #000000;">s</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">k</span> <span style="color: #008080;">then</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">k</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">then</span>
<span style="color: #008080;">if</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">s</span><span style="color: #0000FF;">)=</span><span style="color: #000000;">1</span> <span style="color: #008080;">then</span> <span style="color: #008080;">return</span> <span style="color: #0000FF;">{</span><span style="color: #008000;">"perfect"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">s</span><span style="color: #0000FF;">}</span>
<span style="color: #008080;">elsif</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">s</span><span style="color: #0000FF;">)=</span><span style="color: #000000;">2</span> <span style="color: #008080;">then</span> <span style="color: #008080;">return</span> <span style="color: #0000FF;">{</span><span style="color: #008000;">"amicable"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">s</span><span style="color: #0000FF;">}</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span> <span style="color: #008080;">return</span> <span style="color: #0000FF;">{</span><span style="color: #008000;">"sociable"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">s</span><span style="color: #0000FF;">}</span>
<span style="color: #008080;">elsif</span> <span style="color: #000000;">k</span><span style="color: #0000FF;">=</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">s</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span> <span style="color: #008080;">return</span> <span style="color: #0000FF;">{</span><span style="color: #008000;">"aspiring"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">s</span><span style="color: #0000FF;">}</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span> <span style="color: #008080;">return</span> <span style="color: #0000FF;">{</span><span style="color: #008000;">"cyclic"</span><span style="color: #0000FF;">,</span><span style="color: #7060A8;">append</span><span style="color: #0000FF;">(</span><span style="color: #000000;">s</span><span style="color: #0000FF;">,</span><span style="color: #000000;">n</span><span style="color: #0000FF;">)}</span>
<span style="color: #008080;">elsif</span> <span style="color: #000000;">n</span><span style="color: #0000FF;">=</span><span style="color: #000000;">0</span> <span style="color: #008080;">then</span> <span style="color: #008080;">return</span> <span style="color: #0000FF;">{</span><span style="color: #008000;">"terminating"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">s</span><span style="color: #0000FF;">}</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #000000;">s</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">append</span><span style="color: #0000FF;">(</span><span style="color: #000000;">s</span><span style="color: #0000FF;">,</span><span style="color: #000000;">n</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">while</span>
<span style="color: #008080;">return</span> <span style="color: #0000FF;">{</span><span style="color: #008000;">"non-terminating"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">s</span><span style="color: #0000FF;">}</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #008080;">constant</span> <span style="color: #000000;">n</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">tagset</span><span style="color: #0000FF;">(</span><span style="color: #000000;">12</span><span style="color: #0000FF;">)&{</span><span style="color: #000000;">28</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">496</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">220</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">1184</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">12496</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">1264460</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">790</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">909</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">562</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">1064</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">1488</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">15355717786080</span><span style="color: #0000FF;">}</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">n</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
<span style="color: #0000FF;">{</span><span style="color: #004080;">string</span> <span style="color: #000000;">classification</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">sequence</span> <span style="color: #000000;">dseq</span><span style="color: #0000FF;">}</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">aliquot</span><span style="color: #0000FF;">(</span><span style="color: #000000;">n</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">])</span>
<span style="color: #000000;">dseq</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">join</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">apply</span><span style="color: #0000FF;">(</span><span style="color: #004600;">true</span><span style="color: #0000FF;">,</span><span style="color: #7060A8;">sprintf</span><span style="color: #0000FF;">,{{</span><span style="color: #008000;">"%d"</span><span style="color: #0000FF;">},</span><span style="color: #000000;">dseq</span><span style="color: #0000FF;">}),</span><span style="color: #008000;">","</span><span style="color: #0000FF;">)</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"%14d =&gt; %15s, {%s}\n"</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">n</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">],</span><span style="color: #000000;">classification</span><span style="color: #0000FF;">,</span><span style="color: #000000;">dseq</span><span style="color: #0000FF;">})</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<!--

56
Task/Aliquot-sequence-classifications/Picat/aliquot-sequence-classifications.picat Normal file
View file

@ -0,0 +1,56 @@
divisor_sum(N) = R =>
Total = 1,
Power = 2,
% Deal with powers of 2 first
while (N mod 2 == 0)
Total := Total + Power,
Power := Power*2,
N := N div 2
end,
% Odd prime factors up to the square root
P = 3,
while (P*P =< N)
Sum = 1,
Power1 = P,
while (N mod P == 0)
Sum := Sum + Power1,
Power1 := Power1*P,
N := N div P
end,
Total := Total * Sum,
P := P+2
end,
% If n > 1 then it's prime
if N > 1 then
Total := Total*(N + 1)
end,
R = Total.
% See https://en.wikipedia.org/wiki/Aliquot_sequence
aliquot_sequence(N,Limit,Seq,Class) =>
aliquot_sequence(N,Limit,[N],Seq,Class).
aliquot_sequence(_,0,_,Seq,Class) => Seq = [], Class = 'non-terminating'.
aliquot_sequence(_,_,[0|_],Seq,Class) => Seq = [0], Class = terminating.
aliquot_sequence(N,_,[N,N|_],Seq,Class) => Seq = [], Class = perfect.
aliquot_sequence(N,_,[N,_,N|_],Seq,Class) => Seq = [N], Class = amicable.
aliquot_sequence(N,_,[N|S],Seq,Class), membchk(N,S) =>
Seq = [N], Class = sociable.
aliquot_sequence(_,_,[Term,Term|_],Seq,Class) => Seq = [], Class = aspiring.
aliquot_sequence(_,_,[Term|S],Seq,Class), membchk(Term,S) =>
Seq = [Term], Class = cyclic.
aliquot_sequence(N,Limit,[Term|S],Seq,Class) =>
Seq = [Term|Rest],
Sum = divisor_sum(Term),
Term1 is Sum - Term,
aliquot_sequence(N,Limit-1,[Term1,Term|S],Rest,Class).
main =>
foreach (N in [11,12,28,496,220,1184,12496,1264460,790,909,562,1064,1488,15355717786080,153557177860800])
aliquot_sequence(N,16,Seq,Class),
printf("%w: %w, sequence: %w ", N, Class, Seq[1]),
foreach (I in 2..len(Seq), break(Seq[I] == Seq[I-1]))
printf("%w ", Seq[I])
end,
nl
end.

34
Task/Aliquot-sequence-classifications/PowerShell/aliquot-sequence-classifications-1.psh Normal file
View file

@ -0,0 +1,34 @@
function Get-NextAliquot ( [int]$X )
{
If ( $X -gt 1 )
{
$NextAliquot = 0
(1..($X/2)).Where{ $x % $_ -eq 0 }.ForEach{ $NextAliquot += $_ }.Where{ $_ }
return $NextAliquot
}
}
function Get-AliquotSequence ( [int]$K, [int]$N )
{
$X = $K
$X
(1..($N-1)).ForEach{ $X = Get-NextAliquot $X; $X }
}
function Classify-AlliquotSequence ( [int[]]$Sequence )
{
$K = $Sequence[0]
$LastN = $Sequence.Count
If ( $Sequence[-1] -eq 0 ) { return "terminating" }
If ( $Sequence[-1] -eq 1 ) { return "terminating" }
If ( $Sequence[1] -eq $K ) { return "perfect" }
If ( $Sequence[2] -eq $K ) { return "amicable" }
If ( $Sequence[3..($Sequence.Count-1)] -contains $K ) { return "sociable" }
If ( $Sequence[-1] -eq $Sequence[-2] ) { return "aspiring" }
If ( $Sequence.Count -gt ( $Sequence | Select -Unique ).Count ) { return "cyclic" }
return "non-terminating and non-repeating through N = $($Sequence.Count)"
}
(1..10).ForEach{ [string]$_ + " is " + ( Classify-AlliquotSequence -Sequence ( Get-AliquotSequence -K $_ -N 16 ) ) }
( 11, 12, 28, 496, 220, 1184, 790, 909, 562, 1064, 1488 ).ForEach{ [string]$_ + " is " + ( Classify-AlliquotSequence -Sequence ( Get-AliquotSequence -K $_ -N 16 ) ) }

63
Task/Aliquot-sequence-classifications/PowerShell/aliquot-sequence-classifications-2.psh Normal file
View file

@ -0,0 +1,63 @@
function Get-NextAliquot ( [int]$X )
{
If ( $X -gt 1 )
{
$NextAliquot = 1
If ( $X -gt 2 )
{
$XSquareRoot = [math]::Sqrt( $X )
(2..$XSquareRoot).Where{ $X % $_ -eq 0 }.ForEach{ $NextAliquot += $_ + $x / $_ }
If ( $XSquareRoot % 1 -eq 0 ) { $NextAliquot -= $XSquareRoot }
}
return $NextAliquot
}
}
function Get-AliquotSequence ( [int]$K, [int]$N )
{
$X = $K
$X
$i = 1
While ( $X -and $i -lt $N )
{
$i++
$Next = Get-NextAliquot $X
If ( $Next )
{
If ( $X -eq $Next )
{
($i..$N).ForEach{ $X }
$i = $N
}
Else
{
$X = $Next
$X
}
}
Else
{
$i = $N
}
}
}
function Classify-AlliquotSequence ( [int[]]$Sequence )
{
$K = $Sequence[0]
$LastN = $Sequence.Count
If ( $Sequence[-1] -eq 0 ) { return "terminating" }
If ( $Sequence[-1] -eq 1 ) { return "terminating" }
If ( $Sequence[1] -eq $K ) { return "perfect" }
If ( $Sequence[2] -eq $K ) { return "amicable" }
If ( $Sequence[3..($Sequence.Count-1)] -contains $K ) { return "sociable" }
If ( $Sequence[-1] -eq $Sequence[-2] ) { return "aspiring" }
If ( $Sequence.Count -gt ( $Sequence | Select -Unique ).Count ) { return "cyclic" }
return "non-terminating and non-repeating through N = $($Sequence.Count)"
}
(1..10).ForEach{ [string]$_ + " is " + ( Classify-AlliquotSequence -Sequence ( Get-AliquotSequence -K $_ -N 16 ) ) }
( 11, 12, 28, 496, 220, 1184, 12496, 1264460, 790, 909, 562, 1064, 1488 ).ForEach{ [string]$_ + " is " + ( Classify-AlliquotSequence -Sequence ( Get-AliquotSequence -K $_ -N 16 ) ) }

90
Task/Aliquot-sequence-classifications/PowerShell/aliquot-sequence-classifications-3.psh Normal file
View file

@ -0,0 +1,90 @@
function Get-Aliquot
{
[CmdletBinding()]
[OutputType([PScustomObject])]
Param
(
[Parameter(Mandatory=$true,
ValueFromPipeline=$true,
ValueFromPipelineByPropertyName=$true)]
[int]
$InputObject
)
Begin
{
function Get-NextAliquot ([int]$X)
{
if ($X -gt 1)
{
$nextAliquot = 1
if ($X -gt 2)
{
$xSquareRoot = [Math]::Sqrt($X)
2..$xSquareRoot | Where-Object {$X % $_ -eq 0} | ForEach-Object {$nextAliquot += $_ + $x / $_}
if ($xSquareRoot % 1 -eq 0) {$nextAliquot -= $xSquareRoot}
}
$nextAliquot
}
}
function Get-AliquotSequence ([int]$K, [int]$N)
{
$X = $K
$X
$i = 1
while ($X -and $i -lt $N)
{
$i++
$next = Get-NextAliquot $X
if ($next)
{
if ($X -eq $next)
{
$i..$N | ForEach-Object {$X}
$i = $N
}
else
{
$X = $next
$X
}
}
else
{
$i = $N
}
}
}
function Classify-AlliquotSequence ([int[]]$Sequence)
{
$k = $Sequence[0]
if ($Sequence[-1] -eq 0) {return "terminating"}
if ($Sequence[-1] -eq 1) {return "terminating"}
if ($Sequence[1] -eq $k) {return "perfect" }
if ($Sequence[2] -eq $k) {return "amicable" }
if ($Sequence[3..($Sequence.Count-1)] -contains $k) {return "sociable" }
if ($Sequence[-1] -eq $Sequence[-2] ) {return "aspiring" }
if ($Sequence.Count -gt ($Sequence | Select -Unique).Count ) {return "cyclic" }
return "non-terminating and non-repeating through N = $($Sequence.Count)"
}
}
Process
{
$_ | ForEach-Object {
[PSCustomObject]@{
Number = $_
Classification = (Classify-AlliquotSequence -Sequence (Get-AliquotSequence -K $_ -N 16))
}
}
}
}

5
Task/Aliquot-sequence-classifications/PowerShell/aliquot-sequence-classifications-4.psh Normal file
View file

@ -0,0 +1,5 @@
$oneToTen = 1..10 | Get-Aliquot
$selected = 11, 12, 28, 496, 220, 1184, 12496, 1264460, 790, 909, 562, 1064, 1488 | Get-Aliquot
$numbers = $oneToTen, $selected
$numbers

69
Task/Aliquot-sequence-classifications/Prolog/aliquot-sequence-classifications.pro Normal file
View file

@ -0,0 +1,69 @@
% See https://en.wikipedia.org/wiki/Divisor_function
divisor_sum(N, Total):-
divisor_sum_prime(N, 2, 2, Total1, 1, N1),
divisor_sum(N1, 3, Total, Total1).
divisor_sum(1, _, Total, Total):-
!.
divisor_sum(N, Prime, Total, Running_total):-
Prime * Prime =< N,
!,
divisor_sum_prime(N, Prime, Prime, P, 1, M),
Next_prime is Prime + 2,
Running_total1 is P * Running_total,
divisor_sum(M, Next_prime, Total, Running_total1).
divisor_sum(N, _, Total, Running_total):-
Total is (N + 1) * Running_total.
divisor_sum_prime(N, Prime, Power, Total, Running_total, M):-
0 is N mod Prime,
!,
Running_total1 is Running_total + Power,
Power1 is Power * Prime,
N1 is N // Prime,
divisor_sum_prime(N1, Prime, Power1, Total, Running_total1, M).
divisor_sum_prime(N, _, _, Total, Total, N).
% See https://en.wikipedia.org/wiki/Aliquot_sequence
aliquot_sequence(N, Limit, Sequence, Class):-
aliquot_sequence(N, Limit, [N], Sequence, Class).
aliquot_sequence(_, 0, _, [], 'non-terminating'):-!.
aliquot_sequence(_, _, [0|_], [0], terminating):-!.
aliquot_sequence(N, _, [N, N|_], [], perfect):-!.
aliquot_sequence(N, _, [N, _, N|_], [N], amicable):-!.
aliquot_sequence(N, _, [N|S], [N], sociable):-
memberchk(N, S),
!.
aliquot_sequence(_, _, [Term, Term|_], [], aspiring):-!.
aliquot_sequence(_, _, [Term|S], [Term], cyclic):-
memberchk(Term, S),
!.
aliquot_sequence(N, Limit, [Term|S], [Term|Rest], Class):-
divisor_sum(Term, Sum),
Term1 is Sum - Term,
L1 is Limit - 1,
aliquot_sequence(N, L1, [Term1, Term|S], Rest, Class).
write_aliquot_sequence(N, Sequence, Class):-
writef('%w: %w, sequence:', [N, Class]),
write_aliquot_sequence(Sequence).
write_aliquot_sequence([]):-
nl,
!.
write_aliquot_sequence([Term|Rest]):-
writef(' %w', [Term]),
write_aliquot_sequence(Rest).
main:-
between(1, 10, N),
aliquot_sequence(N, 16, Sequence, Class),
write_aliquot_sequence(N, Sequence, Class),
fail.
main:-
member(N, [11, 12, 28, 496, 220, 1184, 12496, 1264460, 790, 909, 562, 1064, 1488]),
aliquot_sequence(N, 16, Sequence, Class),
write_aliquot_sequence(N, Sequence, Class),
fail.
main.

41
Task/Aliquot-sequence-classifications/Python/aliquot-sequence-classifications.py Normal file
View file

@ -0,0 +1,41 @@
from proper_divisors import proper_divs
from functools import lru_cache
@lru_cache()
def pdsum(n):
return sum(proper_divs(n))
def aliquot(n, maxlen=16, maxterm=2**47):
if n == 0:
return 'terminating', [0]
s, slen, new = [n], 1, n
while slen <= maxlen and new < maxterm:
new = pdsum(s[-1])
if new in s:
if s[0] == new:
if slen == 1:
return 'perfect', s
elif slen == 2:
return 'amicable', s
else:
return 'sociable of length %i' % slen, s
elif s[-1] == new:
return 'aspiring', s
else:
return 'cyclic back to %i' % new, s
elif new == 0:
return 'terminating', s + [0]
else:
s.append(new)
slen += 1
else:
return 'non-terminating', s
if __name__ == '__main__':
for n in range(1, 11):
print('%s: %r' % aliquot(n))
print()
for n in [11, 12, 28, 496, 220, 1184, 12496, 1264460, 790, 909, 562, 1064, 1488, 15355717786080]:
print('%s: %r' % aliquot(n))

56
Task/Aliquot-sequence-classifications/QBasic/aliquot-sequence-classifications.basic Normal file
View file

@ -0,0 +1,56 @@
DECLARE FUNCTION PDtotal! (n!)
DECLARE SUB PrintAliquotClassifier (K!)
CLS
CONST limite = 10000000
DIM nums(22)
DATA 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 28, 496
DATA 220, 1184, 12496, 790, 909, 562, 1064, 1488
FOR n = 1 TO UBOUND(nums)
READ nums(n)
PRINT "Number"; nums(n); " :";
PrintAliquotClassifier (nums(n))
NEXT n
PRINT "Program normal end."
END
FUNCTION PDtotal (n)
total = 0
FOR y = 2 TO n
IF (n MOD y) = 0 THEN total = total + (n / y)
NEXT y
PDtotal = total
END FUNCTION
SUB PrintAliquotClassifier (K)
longit = 52: n = K: clase = 0: priorn = 0: inc = 0
DIM Aseq(longit)
FOR element = 2 TO longit
Aseq(element) = PDtotal(n)
PRINT Aseq(element); " ";
COLOR 3
SELECT CASE Aseq(element)
CASE 0
PRINT " Terminating": clase = 1: EXIT FOR
CASE K AND element = 2
PRINT " Perfect": clase = 2: EXIT FOR
CASE K AND element = 3
PRINT " Amicable": clase = 3: EXIT FOR
CASE K AND element > 3
PRINT " Sociable": clase = 4: EXIT FOR
CASE Aseq(element) <> K AND Aseq(element - 1) = Aseq(element)
PRINT " Aspiring": clase = 5: EXIT FOR
CASE Aseq(element) <> K AND Aseq(element - 2) = Aseq(element)
PRINT " Cyclic": clase = 6: EXIT FOR
END SELECT
COLOR 7
n = Aseq(element)
IF n > priorn THEN priorn = n: inc = inc + 1 ELSE inc = 0: priorn = 0
IF inc = 11 OR n > limite THEN EXIT FOR
NEXT element
IF clase = 0 THEN COLOR 12: PRINT " non-terminating"
COLOR 7
END SUB

63
Task/Aliquot-sequence-classifications/REXX/aliquot-sequence-classifications.rexx Normal file
View file

@ -0,0 +1,63 @@
/*REXX program classifies various positive integers for types of aliquot sequences. */
parse arg low high $L /*obtain optional arguments from the CL*/
high= word(high low 10,1); 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
numeric digits 100 /*be able to compute the number: BIG */
big= 2**47; NTlimit= 16 + 1 /*limits for a non─terminating sequence*/
numeric digits max(9, length(big) ) /*be able to handle big numbers for // */
digs= digits() /*used for align numbers for the output*/
#.= .; #.0= 0; #.1= 0 /*#. are the proper divisor sums. */
say center('numbers from ' low " ───► " high ' (inclusive)', 153, "═")
do n=low to high; call classify n /*call a subroutine to classify number.*/
end /*n*/ /* [↑] process a range of integers. */
say
say center('first numbers for each classification', 153, "═")
class.= 0 /* [↓] ensure one number of each class*/
do q=1 until class.sociable\==0 /*the only one that has to be counted. */
call classify -q /*minus (-) sign indicates don't tell. */
_= what; upper _ /*obtain the class and uppercase it. */
class._= class._ + 1 /*bump counter for this class sequence.*/
if class._==1 then say right(q, digs)':' center(what, digs) $
end /*q*/ /* [↑] only display the 1st occurrence*/
say /* [↑] process until all classes found*/
say center('classifications for specific numbers', 153, "═")
do i=1 for words($L) /*$L: is a list of "special numbers".*/
call classify word($L, i) /*call a subroutine to classify number.*/
end /*i*/ /* [↑] process a list of integers. */
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
classify: parse arg a 1 aa; a= abs(a) /*obtain number that's to be classified*/
if #.a\==. then s= #.a /*Was this number been summed before?*/
else s= sigma(a) /*No, then classify number the hard way*/
#.a= s /*define sum of the proper divisors. */
$= 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 $==a then what= 'perfect' /*check for a "perfect" number. */
else do t=1 while s>0 /*loop until sum isn't 0 or > big.*/
m= s /*obtain the last number in sequence. */
if #.m==. then s= sigma(m) /*Not defined? Then sum proper divisors*/
else s= #.m /*use the previously found integer. */
if m==s then if m>=0 then do; what= 'aspiring'; leave; end
parse var $ . word2 . /*obtain the 2nd number in sequence. */
if word2==a then do; what= 'amicable'; leave; end
$= $ 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 /*t*/ /* [↑] only permit within reason. */
if aa>0 then say right(a, digs)':' center(what, digs) $
return /* [↑] only display if AA is positive*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
sigma: procedure expose #. !.; parse arg x; if 11<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 √ X */
if x//j==0 then s= s + j + x % j /*add the two divisors to the sum. */
end /*j*/ /* [↓] adjust for square. ___*/
if j*j==x then s= s + j /*Was X a square? If so, add √ X */
#.x= s /*memoize division sum for argument X.*/
return s /*return " " " " " */

53
Task/Aliquot-sequence-classifications/Racket/aliquot-sequence-classifications.rkt Normal file
View file

@ -0,0 +1,53 @@
#lang racket
(require "proper-divisors.rkt" math/number-theory)
(define SCOPE 20000)
(define P
(let ((P-v (vector)))
(λ (n)
(cond
[(> n SCOPE)
(apply + (drop-right (divisors n) 1))]
[else
(set! P-v (fold-divisors P-v n 0 +))
(vector-ref P-v n)]))))
;; initialise P-v
(void (P SCOPE))
(define (aliquot-sequence-class K)
;; note that seq is reversed as a list, since we're consing
(define (inr-asc seq)
(match seq
[(list 0 _ ...)
(values "terminating" seq)]
[(list (== K) (== K) _ ...)
(values "perfect" seq)]
[(list n n _ ...)
(values (format "aspiring to ~a" n) seq)]
[(list (== K) ami (== K) _ ...)
(values (format "amicable with ~a" ami) seq)]
[(list (== K) cycle ... (== K))
(values (format "sociable length ~a" (add1 (length cycle))) seq)]
[(list n cycle ... n _ ...)
(values (format "cyclic on ~a length ~a" n (add1 (length cycle))) seq)]
[(list X _ ...)
#:when (> X 140737488355328)
(values "non-terminating big number" seq)]
[(list seq ...)
#:when (> (length seq) 16)
(values "non-terminating long sequence" seq)]
[(list seq1 seq ...) (inr-asc (list* (P seq1) seq1 seq))]))
(inr-asc (list K)))
(define (report-aliquot-sequence-class n)
(define-values (c s) (aliquot-sequence-class n))
(printf "~a:\t~a\t~a~%" n c (reverse s)))
(for ((i (in-range 1 10)))
(report-aliquot-sequence-class i))
(newline)
(for ((i (in-list '(11 12 28 496 220 1184 12496 1264460 790 909 562 1064 1488 15355717786080))))
(report-aliquot-sequence-class i))

34
Task/Aliquot-sequence-classifications/Raku/aliquot-sequence-classifications.raku Normal file
View file

@ -0,0 +1,34 @@
sub propdivsum (\x) {
my @l = x > 1;
(2 .. x.sqrt.floor).map: -> \d {
unless x % d { my \y = x div d; y == d ?? @l.push: d !! @l.append: d,y }
}
sum @l;
}
multi quality (0,1) { 'perfect ' }
multi quality (0,2) { 'amicable' }
multi quality (0,$n) { "sociable-$n" }
multi quality ($,1) { 'aspiring' }
multi quality ($,$n) { "cyclic-$n" }
sub aliquotidian ($x) {
my %seen;
my @seq = $x, &propdivsum ... *;
for 0..16 -> $to {
my $this = @seq[$to] or return "$x\tterminating\t[@seq[^$to]]";
last if $this > 140737488355328;
if %seen{$this}:exists {
my $from = %seen{$this};
return "$x\t&quality($from, $to-$from)\t[@seq[^$to]]";
}
%seen{$this} = $to;
}
"$x non-terminating\t[{@seq}]";
}
aliquotidian($_).say for flat
1..10,
11, 12, 28, 496, 220, 1184, 12496, 1264460,
790, 909, 562, 1064, 1488,
15355717786080;

78
Task/Aliquot-sequence-classifications/Ring/aliquot-sequence-classifications.ring Normal file
View file

@ -0,0 +1,78 @@
# Project : Aliquot sequence classnifications
see "Rosetta Code - aliquot sequence classnifications" + nl
while true
see "enter an integer: "
give k
k=fabs(floor(number(k)))
if k=0
exit
ok
printas(k)
end
see "program complete."
func printas(k)
length=52
aseq = list(length)
n=k
classn=0
priorn = 0
inc = 0
for element=2 to length
aseq[element]=pdtotal(n)
see aseq[element] + " " + nl
if aseq[element]=0
see " terminating" + nl
classn=1
exit
ok
if aseq[element]=k and element=2
see " perfect" + nl
classn=2
exit
ok
if aseq[element]=k and element=3
see " amicable" + nl
classn=3
exit
ok
if aseq[element]=k and element>3
see " sociable" + nl
classn=4
exit
ok
if aseq[element]!=k and aseq[element-1]=aseq[element]
see " aspiring" + nl
classn=5
exit
ok
if aseq[element]!=k and element>2 and aseq[element-2]= aseq[element]
see " cyclic" + nl
classn=6
exit
ok
n=aseq[element]
if n>priorn
priorn=n
inc=inc+1
but n<=priorn
inc=0
priorn=0
ok
if inc=11 or n>30000000
exit
ok
next
if classn=0
see " non-terminating" + nl
ok
func pdtotal(n)
pdtotal = 0
for y=2 to n
if (n % y)=0
pdtotal=pdtotal+(n/y)
ok
next
return pdtotal

29
Task/Aliquot-sequence-classifications/Ruby/aliquot-sequence-classifications.rb Normal file
View file

@ -0,0 +1,29 @@
def aliquot(n, maxlen=16, maxterm=2**47)
return "terminating", [0] if n == 0
s = []
while (s << n).size <= maxlen and n < maxterm
n = n.proper_divisors.inject(0, :+)
if s.include?(n)
case n
when s[0]
case s.size
when 1 then return "perfect", s
when 2 then return "amicable", s
else return "sociable of length #{s.size}", s
end
when s[-1] then return "aspiring", s
else return "cyclic back to #{n}", s
end
elsif n == 0 then return "terminating", s << 0
end
end
return "non-terminating", s
end
for n in 1..10
puts "%20s: %p" % aliquot(n)
end
puts
for n in [11, 12, 28, 496, 220, 1184, 12496, 1264460, 790, 909, 562, 1064, 1488, 15355717786080]
puts "%20s: %p" % aliquot(n)
end

45
Task/Aliquot-sequence-classifications/Rust/aliquot-sequence-classifications.rust Normal file
View file

@ -0,0 +1,45 @@
#[derive(Debug)]
enum AliquotType { Terminating, Perfect, Amicable, Sociable, Aspiring, Cyclic, NonTerminating }
fn classify_aliquot(num: i64) -> (AliquotType, Vec<i64>) {
let limit = 1i64 << 47; //140737488355328
let mut terms = Some(num).into_iter().collect::<Vec<_>>();
for i in 0..16 {
let n = terms[i];
let divsum = (1..(n + 1) / 2 + 1).filter(|&x| n % x == 0 && n != x).fold(0, |sum, x| sum + x);
let classification = if divsum == 0 {
Some(AliquotType::Terminating)
}
else if divsum > limit {
Some(AliquotType::NonTerminating)
}
else if let Some(prev_idx) = terms.iter().position(|&x| x == divsum) {
let cycle_len = terms.len() - prev_idx;
Some(if prev_idx == 0 {
match cycle_len {
1 => AliquotType::Perfect,
2 => AliquotType::Amicable,
_ => AliquotType::Sociable
}
}
else {
if cycle_len == 1 {AliquotType::Aspiring} else {AliquotType::Cyclic}
})
}
else {
None
};
terms.push(divsum);
if let Some(result) = classification {
return (result, terms);
}
}
(AliquotType::NonTerminating, terms)
}
fn main() {
let nums = [1i64, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 28, 496, 220, 1184, 12496, 1264460, 790, 909, 562, 1064, 1488/*, 15355717786080*/];
for num in &nums {
println!("{} {:?}", num, classify_aliquot(*num));
}
}

20
Task/Aliquot-sequence-classifications/Scala/aliquot-sequence-classifications.scala Normal file
View file

@ -0,0 +1,20 @@
def createAliquotSeq(n: Long, step: Int, list: List[Long]): (String, List[Long]) = {
val sum = properDivisors(n).sum
if (sum == 0) ("terminate", list ::: List(sum))
else if (step >= 16 || sum > 140737488355328L) ("non-term", list)
else {
list.indexOf(sum) match {
case -1 => createAliquotSeq(sum, step + 1, list ::: List(sum))
case 0 => if (step == 0) ("perfect", list ::: List(sum))
else if (step == 1) ("amicable", list ::: List(sum))
else ("sociable-" + (step + 1), list ::: List(sum))
case index => if (step == index) ("aspiring", list ::: List(sum))
else ("cyclic-" + (step - index + 1), list ::: List(sum))
}
}
}
val numbers = List(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 28, 496, 220, 1184,
12496, 1264460, 790, 909, 562, 1064, 1488, 15355717786080L)
val result = numbers.map(i => createAliquotSeq(i, 0, List(i)))
result foreach { v => println(f"${v._2.head}%14d ${v._1}%10s [${v._2 mkString " "}]" ) }

67
Task/Aliquot-sequence-classifications/Swift/aliquot-sequence-classifications.swift Normal file
View file

@ -0,0 +1,67 @@
extension BinaryInteger {
@inlinable
public func factors(sorted: Bool = true) -> [Self] {
let maxN = Self(Double(self).squareRoot())
var res = Set<Self>()
for factor in stride(from: 1, through: maxN, by: 1) where self % factor == 0 {
res.insert(factor)
res.insert(self / factor)
}
return sorted ? res.sorted() : Array(res)
}
}
struct SeqClass: CustomStringConvertible {
var seq: [Int]
var desc: String
var description: String {
return "\(desc): \(seq)"
}
}
func classifySequence(k: Int, threshold: Int = 1 << 47) -> SeqClass {
var last = k
var seq = [k]
while true {
last = last.factors().dropLast().reduce(0, +)
seq.append(last)
let n = seq.count
if last == 0 {
return SeqClass(seq: seq, desc: "Terminating")
} else if n == 2 && last == k {
return SeqClass(seq: seq, desc: "Perfect")
} else if n == 3 && last == k {
return SeqClass(seq: seq, desc: "Amicable")
} else if n >= 4 && last == k {
return SeqClass(seq: seq, desc: "Sociable[\(n - 1)]")
} else if last == seq[n - 2] {
return SeqClass(seq: seq, desc: "Aspiring")
} else if seq.dropFirst().dropLast(2).contains(last) {
return SeqClass(seq: seq, desc: "Cyclic[\(n - 1 - seq.firstIndex(of: last)!)]")
} else if n == 16 || last > threshold {
return SeqClass(seq: seq, desc: "Non-terminating")
}
}
fatalError()
}
for i in 1...10 {
print("\(i): \(classifySequence(k: i))")
}
print()
for i in [11, 12, 28, 496, 220, 1184, 12496, 1264460, 790, 909, 562, 1064, 1488] {
print("\(i): \(classifySequence(k: i))")
}
print()
print("\(15355717786080): \(classifySequence(k: 15355717786080))")

73
Task/Aliquot-sequence-classifications/Tcl/aliquot-sequence-classifications.tcl Normal file
View file

@ -0,0 +1,73 @@
proc ProperDivisors {n} {
if {$n == 1} {return 0}
set divs 1
set sum 1
for {set i 2} {$i*$i <= $n} {incr i} {
if {! ($n % $i)} {
lappend divs $i
incr sum $i
if {$i*$i<$n} {
lappend divs [set d [expr {$n / $i}]]
incr sum $d
}
}
}
list $sum $divs
}
proc al_iter {n} {
yield [info coroutine]
while {$n} {
yield $n
lassign [ProperDivisors $n] n
}
yield 0
return -code break
}
proc al_classify {n} {
coroutine iter al_iter $n
set items {}
try {
set type "non-terminating"
while {[llength $items] < 16} {
set i [iter]
if {$i == 0} {
set type "terminating"
}
set ix [lsearch -exact $items $i]
set items [linsert $items 0 $i]
switch $ix {
-1 { continue }
0 { throw RESULT "perfect" }
1 { throw RESULT "amicable" }
default { throw RESULT "sociable" }
}
}
} trap {RESULT} {type} {
rename iter {}
set map {
perfect aspiring
amicable cyclic
sociable cyclic
}
if {$ix != [llength $items]-2} {
set type [dict get $map $type]
}
}
list $type [lreverse $items]
}
for {set i 1} {$i <= 10} {incr i} {
puts [format "%8d -> %-16s : %s" $i {*}[al_classify $i]]
}
foreach i {11 12 28 496 220 1184 12496 1264460 790 909 562 1064 1488 } {
puts [format "%8d -> %-16s : %s" $i {*}[al_classify $i]]
}
;# stretch goal .. let's time it:
set i 15355717786080
puts [time {
puts [format "%8d -> %-16s : %s" $i {*}[al_classify $i]]
}]

105
Task/Aliquot-sequence-classifications/V-(Vlang)/aliquot-sequence-classifications.v Normal file
View file

@ -0,0 +1,105 @@
import math
const threshold = u64(1) << 47
fn index_of(s []u64, search u64) int {
for i, e in s {
if e == search {
return i
}
}
return -1
}
fn contains(s []u64, search u64) bool {
return index_of(s, search) > -1
}
fn max_of(i1 int, i2 int) int {
if i1 > i2 {
return i1
}
return i2
}
fn sum_proper_divisors(n u64) u64 {
if n < 2 {
return 0
}
sqrt := u64(math.sqrt(f64(n)))
mut sum := u64(1)
for i := u64(2); i <= sqrt; i++ {
if n % i != 0 {
continue
}
sum += i + n / i
}
if sqrt * sqrt == n {
sum -= sqrt
}
return sum
}
fn classify_sequence(k u64) ([]u64, string) {
if k == 0 {
panic("Argument must be positive.")
}
mut last := k
mut seq := []u64{}
seq << k
for {
last = sum_proper_divisors(last)
seq << last
n := seq.len
mut aliquot := ""
match true {
last == 0 {
aliquot = "Terminating"
}
n == 2 && last == k {
aliquot = "Perfect"
}
n == 3 && last == k {
aliquot = "Amicable"
}
n >= 4 && last == k {
aliquot = "Sociable[${n-1}]"
}
last == seq[n - 2] {
aliquot = "Aspiring"
}
contains(seq[1 .. max_of(1, n - 2)], last) {
aliquot = "Cyclic[${n - 1 - index_of(seq, last)}]"
}
n == 16 || last > threshold {
aliquot = "Non-Terminating"
}
else {}
}
if aliquot != "" {
return seq, aliquot
}
}
return seq, ''
}
fn main() {
println("Aliquot classifications - periods for Sociable/Cyclic in square brackets:\n")
for k := u64(1); k <= 10; k++ {
seq, aliquot := classify_sequence(k)
println("${k:2}: ${aliquot:-15} $seq")
}
println('')
s := [
u64(11), 12, 28, 496, 220, 1184, 12496, 1264460, 790, 909, 562, 1064, 1488,
]
for k in s {
seq, aliquot := classify_sequence(k)
println("${k:7}: ${aliquot:-15} $seq")
}
println('')
k := u64(15355717786080)
seq, aliquot := classify_sequence(k)
println("$k: ${aliquot:-15} $seq")
}

66
Task/Aliquot-sequence-classifications/VBA/aliquot-sequence-classifications.vba Normal file
View file

@ -0,0 +1,66 @@
Option Explicit
Private Type Aliquot
Sequence() As Double
Classification As String
End Type
Sub Main()
Dim result As Aliquot, i As Long, j As Double, temp As String
'display the classification and sequences of the numbers one to ten inclusive
For j = 1 To 10
result = Aliq(j)
temp = vbNullString
For i = 0 To UBound(result.Sequence)
temp = temp & result.Sequence(i) & ", "
Next i
Debug.Print "Aliquot seq of " & j & " : " & result.Classification & " " & Left(temp, Len(temp) - 2)
Next j
'show the classification and sequences of the following integers, in order:
Dim a
'15 355 717 786 080 : impossible in VBA ==> out of memory
a = Array(11, 12, 28, 496, 220, 1184, 12496, 1264460, 790, 909, 562, 1064, 1488)
For j = LBound(a) To UBound(a)
result = Aliq(CDbl(a(j)))
temp = vbNullString
For i = 0 To UBound(result.Sequence)
temp = temp & result.Sequence(i) & ", "
Next i
Debug.Print "Aliquot seq of " & a(j) & " : " & result.Classification & " " & Left(temp, Len(temp) - 2)
Next
End Sub
Private Function Aliq(Nb As Double) As Aliquot
Dim s() As Double, i As Long, temp, j As Long, cpt As Long
temp = Array("non-terminating", "Terminate", "Perfect", "Amicable", "Sociable", "Aspiring", "Cyclic")
ReDim s(0)
s(0) = Nb
For i = 1 To 15
cpt = cpt + 1
ReDim Preserve s(cpt)
s(i) = SumPDiv(s(i - 1))
If s(i) > 140737488355328# Then Exit For
If s(i) = 0 Then j = 1
If s(1) = s(0) Then j = 2
If s(i) = s(0) And i > 1 And i <> 2 Then j = 4
If s(i) = s(i - 1) And i > 1 Then j = 5
If i >= 2 Then
If s(2) = s(0) Then j = 3
If s(i) = s(i - 2) And i <> 2 Then j = 6
End If
If j > 0 Then Exit For
Next
Aliq.Classification = temp(j)
Aliq.Sequence = s
End Function
Private Function SumPDiv(n As Double) As Double
'returns the sum of the Proper divisors of n
Dim j As Long, t As Long
If n > 1 Then
For j = 1 To n \ 2
If n Mod j = 0 Then t = t + j
Next
End If
SumPDiv = t
End Function

53
Task/Aliquot-sequence-classifications/Wren/aliquot-sequence-classifications.wren Normal file
View file

@ -0,0 +1,53 @@
import "/fmt" for Conv, Fmt
import "/math" for Int, Nums
import "/seq" for Lst
class Classification {
construct new(seq, aliquot) {
_seq = seq
_aliquot = aliquot
}
seq { _seq}
aliquot { _aliquot }
}
var THRESHOLD = 2.pow(47)
var classifySequence = Fn.new { |k|
if (k <= 0) Fiber.abort("K must be positive")
var last = k
var seq = [k]
while (true) {
last = Nums.sum(Int.properDivisors(last))
seq.add(last)
var n = seq.count
var aliquot =
(last == 0) ? "Terminating" :
(n == 2 && last == k) ? "Perfect" :
(n == 3 && last == k) ? "Amicable" :
(n >= 4 && last == k) ? "Sociable[%(n-1)]" :
(last == seq[n-2]) ? "Aspiring" :
(n > 3 && seq[1..n-3].contains(last)) ? "Cyclic[%(n-1-Lst.indexOf(seq, last))]" :
(n == 16 || last > THRESHOLD) ? "Non-terminating" : ""
if (aliquot != "") return Classification.new(seq, aliquot)
}
}
System.print("Aliquot classifications - periods for Sociable/Cyclic in square brackets:\n")
for (k in 1..10) {
var c = classifySequence.call(k)
System.print("%(Fmt.d(2, k)): %(Fmt.s(-15, c.aliquot)) %(c.seq)")
}
System.print()
var a = [11, 12, 28, 496, 220, 1184, 12496, 1264460, 790, 909, 562, 1064, 1488]
for (k in a) {
var c = classifySequence.call(k)
System.print("%(Fmt.d(7, k)): %(Fmt.s(-15, c.aliquot)) %(c.seq)")
}
System.print()
var k = 15355717786080
var c = classifySequence.call(k)
var seq = c.seq.map { |i| Conv.dec(i) }.toList // ensure 15 digit integer is printed in full
System.print("%(k): %(Fmt.s(-15, c.aliquot)) %(seq)")

61
Task/Aliquot-sequence-classifications/Yabasic/aliquot-sequence-classifications.basic Normal file
View file

@ -0,0 +1,61 @@
// Rosetta Code problem: http://rosettacode.org/wiki/Aliquot_sequence_classifications
// by Galileo, 05/2022
sub sumFactors(n)
local i, s
for i = 1 to n / 2
if not mod(n, i) s = s + i
next
return s
end sub
sub printSeries(arr(), size, ty$)
local i
print "Integer: ", arr(0), ", Type: ", ty$, ", Series: ";
for i=0 to size-2
print arr(i), " ";
next i
print
end sub
sub alliquot(n)
local arr(16), i, j, ty$
ty$ = "Sociable"
arr(0) = n
for i = 1 to 15
arr(i) = sumFactors(arr(i-1))
if arr(i)=0 or arr(i)=n or (arr(i) = arr(i-1) and arr(i)<>n) then
if arr(i) = 0 then
ty$ = "Terminating"
elsif arr(i) = n and i = 1 then
ty$ = "Perfect"
elsif arr(i) = n and i = 2 then
ty$ = "Amicable"
elsif arr(i) = arr(i-1) and arr(i)<>n then
ty$ = "Aspiring"
end if
printSeries(arr(),i+1,ty$)
return
end if
for j = 1 to i-1
if arr(j) = arr(i) then
printSeries(arr(),i+1,"Cyclic")
return
end if
next j
next i
printSeries(arr(),i+1,"Non-Terminating")
end sub
data 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 28, 496, 220, 1184
data 12496, 1264460, 790, 909, 562, 1064, 1488, 0
do
read n
if not n break
alliquot(n)
loop

41
Task/Aliquot-sequence-classifications/ZX-Spectrum-Basic/aliquot-sequence-classifications.basic Normal file
View file

@ -0,0 +1,41 @@
10 PRINT "Number classification sequence"
20 INPUT "Enter a number (0 to end): ";k: IF k>0 THEN GO SUB 2000: PRINT k;" ";s$: GO TO 20
40 STOP
1000 REM sumprop
1010 IF oldk=1 THEN LET newk=0: RETURN
1020 LET sum=1
1030 LET root=SQR oldk
1040 FOR i=2 TO root-0.1
1050 IF oldk/i=INT (oldk/i) THEN LET sum=sum+i+oldk/i
1060 NEXT i
1070 IF oldk/root=INT (oldk/root) THEN LET sum=sum+root
1080 LET newk=sum
1090 RETURN
2000 REM class
2010 LET oldk=k: LET s$=" "
2020 GO SUB 1000
2030 LET oldk=newk
2040 LET s$=s$+" "+STR$ newk
2050 IF newk=0 THEN LET s$="terminating"+s$: RETURN
2060 IF newk=k THEN LET s$="perfect"+s$: RETURN
2070 GO SUB 1000
2080 LET oldk=newk
2090 LET s$=s$+" "+STR$ newk
2100 IF newk=0 THEN LET s$="terminating"+s$: RETURN
2110 IF newk=k THEN LET s$="amicable"+s$: RETURN
2120 FOR t=4 TO 16
2130 GO SUB 1000
2140 LET s$=s$+" "+STR$ newk
2150 IF newk=0 THEN LET s$="terminating"+s$: RETURN
2160 IF newk=k THEN LET s$="sociable (period "+STR$ (t-1)+")"+s$: RETURN
2170 IF newk=oldk THEN LET s$="aspiring"+s$: RETURN
2180 LET b$=" "+STR$ newk+" ": LET ls=LEN s$: LET lb=LEN b$: LET ls=ls-lb
2190 FOR i=1 TO ls
2200 IF s$(i TO i+lb-1)=b$ THEN LET s$="cyclic (at "+STR$ newk+") "+s$: LET i=ls
2210 NEXT i
2220 IF LEN s$<>(ls+lb) THEN RETURN
2300 IF newk>140737488355328 THEN LET s$="non-terminating (term > 140737488355328)"+s$: RETURN
2310 LET oldk=newk
2320 NEXT t
2330 LET s$="non-terminating (after 16 terms)"+s$
2340 RETURN

4
Task/Aliquot-sequence-classifications/Zkl/aliquot-sequence-classifications-1.zkl Normal file
View file

@ -0,0 +1,4 @@
fcn properDivs(n){ [1.. (n + 1)/2 + 1].filter('wrap(x){ n%x==0 and n!=x }) }
fcn aliquot(k){ //-->Walker
Walker(fcn(rk){ k:=rk.value; if(k)rk.set(properDivs(k).sum()); k }.fp(Ref(k)))
}(10).walk(15).println();

9
Task/Aliquot-sequence-classifications/Zkl/aliquot-sequence-classifications-2.zkl Normal file
View file

@ -0,0 +1,9 @@
fcn aliquot(k){ //-->Walker
Walker(fcn(rk){
k:=rk.value;
rk.set((1).reduce((k + 1)/2, fcn(s,n,k){
s + (k%n==0 and k!=n and n) // s + False == s + 0
},0,k));
k
}.fp(Ref(k)))
}(10).walk(15).println();

22
Task/Aliquot-sequence-classifications/Zkl/aliquot-sequence-classifications-3.zkl Normal file
View file

@ -0,0 +1,22 @@
fcn classify(k){
const MAX=(2).pow(47); // 140737488355328
ak,aks:=aliquot(k), ak.walk(16);
_,a2,a3:=aks;
if(a2==k) return("perfect");
if(a3==k) return("amicable");
aspiring:='wrap(){
foreach n in (aks.len()-1){ if(aks[n]==aks[n+1]) return(True) }
False
};
cyclic:='wrap(){
foreach n in (aks.len()-1){ if(aks[n+1,*].holds(aks[n])) return(aks[n]) }
False
};
(if(aks.filter1('==(0))!=False) "terminating"
else if(n:=aks[1,*].filter1n('==(k))) "sociable of length " + (n+1)
else if(aks.filter1('>(MAX))) "non-terminating"
else if(aspiring()) "aspiring"
else if((c:=cyclic())!=False) "cyclic on " + c
else "non-terminating" )
+ " " + aks.filter();
}

3
Task/Aliquot-sequence-classifications/Zkl/aliquot-sequence-classifications-4.zkl Normal file
View file

@ -0,0 +1,3 @@
[1..10].pump(fcn(k){ "%6d is %s".fmt(k,classify(k)).println() });
T(11,12,28,496,220,1184,12496,1264460,790,909,562,1064,1488)
.pump(fcn(k){ "%6d is %s".fmt(k,classify(k)).println() });