Aliquot sequence classifications: Difference between revisions
(→{{header|Scala}}: Simplification) |
(→{{header|Scala}}: incomplete.) |
||
Line 753: | Line 753: | ||
=={{header|Scala}}== |
=={{header|Scala}}== |
||
{{incomplete|Scala|Doesn't show how properDivisors is put in place}} |
|||
With [[proper_divisors#Scala]] /Proper divisors for big (long) numbers/ in place: |
With [[proper_divisors#Scala]] /Proper divisors for big (long) numbers/ in place: |
||
<lang Scala>def createAliquotSeq(n: Long, step: Int, list: List[Long]): (String, List[Long]) = { |
<lang Scala>def createAliquotSeq(n: Long, step: Int, list: List[Long]): (String, List[Long]) = { |
Revision as of 21:00, 11 February 2015
You are encouraged to solve this task according to the task description, using any language you may know.
An 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.
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'th 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.
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
95, 25, 6, 6, 6, ...
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
562, 284, 220, 284, 220, ...
such K are called cyclic.
- 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
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.
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 = 140737488355328.
- Some K form aliquot sequences that are not known to be either terminating or periodic. these K are to be called non-terminating.
- 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.
- Cf.
- Abundant, deficient and perfect number classifications. (Classifications from only the first two members of the whole sequence).
- Proper divisors
- Amicable pairs
D
<lang d>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[]);
}</lang>
- Output:
Terminating: [1, 0] Terminating: [2, 1, 0] Terminating: [3, 1, 0] Terminating: [4, 3, 1, 0] Terminating: [5, 1, 0] Perfect: [6] Terminating: [7, 1, 0] Terminating: [8, 7, 1, 0] Terminating: [9, 4, 3, 1, 0] Terminating: [10, 8, 7, 1, 0] Terminating: [11, 1, 0] Terminating: [12, 16, 15, 9, 4, 3, 1, 0] Perfect: [28] Perfect: [496] Amicable: [220, 284] Amicable: [1184, 1210] Sociable of length 5: [12496, 14288, 15472, 14536, 14264] Sociable of length 4: [1264460, 1547860, 1727636, 1305184] Aspiring: [790, 650, 652, 496] Aspiring: [909, 417, 143, 25, 6] Cyclic back to 284: [562, 284, 220] Cyclic back to 1184: [1064, 1336, 1184, 1210] Non-terminating: [1488, 2480, 3472, 4464, 8432, 9424, 10416, 21328, 22320, 55056, 95728, 96720, 236592, 459792, 881392, 882384, 1474608]
Haskell
<lang Haskell>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]</lang>
- Output:
(Terminating,[1,0]) (Terminating,[2,1,0]) (Terminating,[3,1,0]) (Terminating,[4,3,1,0]) (Terminating,[5,1,0]) (Perfect,[6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6]) (Terminating,[7,1,0]) (Terminating,[8,7,1,0]) (Terminating,[9,4,3,1,0]) (Terminating,[10,8,7,1,0]) (Terminating,[11,1,0]) (Terminating,[12,16,15,9,4,3,1,0]) (Perfect,[28,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]) (Nonterminating,[1488,2480,3472,4464,8432,9424,10416,21328,22320,55056,95728,96720,236592,459792,881392,882384])
J
<lang J> proper_divisors =: [: */&> [: }: [: , [: { [: <@:({. ^ i.@:>:@:{:)";: [: |: 2 p: x: aliquot =: ([: +/ proper_divisors) ::0: rc_aliquot_sequence =: aliquot^:(i.16)&> rc_classify =: [: {. ([;.1' invalid terminate non-terminating perfect amicable sociable aspiring cyclic') #~ (16 ~: #) , (6 > {:) , (([: +./ (2^47x)&<) +. (16 = #@:~.)) , (1 = #@:~.) , ((8&= , 1&<)@:{.@:(#/.~)) , ([: =/ _2&{.) , 1: rc_display_aliquot_sequence =: (":,~' ',~rc_classify)@:rc_aliquot_sequence </lang> <lang J>
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 112510261154846...
</lang>
jq
<lang jq># "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</lang>
- Output:
<lang sh>$ 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]</lang>
Perl
<lang perl>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;
}</lang>
- Output:
1 terminates [1 0] 2 terminates [2 1 0] 3 terminates [3 1 0] 4 terminates [4 3 1 0] 5 terminates [5 1 0] 6 perfect [6] 7 terminates [7 1 0] 8 terminates [8 7 1 0] 9 terminates [9 4 3 1 0] 10 terminates [10 8 7 1 0] 11 terminates [11 1 0] 12 terminates [12 16 15 9 4 3 1 0] 28 perfect [28] 496 perfect [496] 220 amicible [220 284] 1184 amicible [1184 1210] 12496 sociable-5 [12496 14288 15472 14536 14264] 1264460 sociable-4 [1264460 1547860 1727636 1305184] 790 aspiring [790 650 652 496] 909 aspiring [909 417 143 25 6] 562 cyclic-2 [562 284 220] 1064 cyclic-2 [1064 1336 1184 1210] 1488 non-term [1488 2480 3472 4464 8432 9424 10416 21328 22320 55056 95728 96720 236592 459792 881392 882384] 15355717786080 non-term [15355717786080 44534663601120]
Perl 6
<lang perl6>sub propdivsum (\x) {
[+] x > 1, gather for 2 .. x.sqrt.floor -> \d { my \y = x div d; if y * d == x { take d; take y unless y == d } }
}
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 terminating [@seq[^$to]]"; last if $this > 140737488355328; if %seen{$this}:exists { my $from = %seen{$this}; return "$x &quality($from, $to-$from) [@seq[^$to]]"; } %seen{$this} = $to; } "$x non-terminating";
}
aliquotidian($_).say for
1..10, 11, 12, 28, 496, 220, 1184, 12496, 1264460, 790, 909, 562, 1064, 1488, 15355717786080;</lang>
- Output:
1 terminating [1] 2 terminating [2 1] 3 terminating [3 1] 4 terminating [4 3 1] 5 terminating [5 1] 6 perfect [6] 7 terminating [7 1] 8 terminating [8 7 1] 9 terminating [9 4 3 1] 10 terminating [10 8 7 1] 11 terminating [11 1] 12 terminating [12 16 15 9 4 3 1] 28 perfect [28] 496 perfect [496] 220 amicable [220 284] 1184 amicable [1184 1210] 12496 sociable-5 [12496 14288 15472 14536 14264] 1264460 sociable-4 [1264460 1547860 1727636 1305184] 790 aspiring [790 650 652 496] 909 aspiring [909 417 143 25 6] 562 cyclic-2 [562 284 220] 1064 cyclic-2 [1064 1336 1184 1210] 1488 non-terminating 15355717786080 non-terminating
Python
Importing Proper divisors from prime factors:
<lang python>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))</lang>
- Output:
terminating: [1, 0] terminating: [2, 1, 0] terminating: [3, 1, 0] terminating: [4, 3, 1, 0] terminating: [5, 1, 0] perfect: [6] terminating: [7, 1, 0] terminating: [8, 7, 1, 0] terminating: [9, 4, 3, 1, 0] terminating: [10, 8, 7, 1, 0] terminating: [11, 1, 0] terminating: [12, 16, 15, 9, 4, 3, 1, 0] perfect: [28] perfect: [496] amicable: [220, 284] amicable: [1184, 1210] sociable of length 5: [12496, 14288, 15472, 14536, 14264] sociable of length 4: [1264460, 1547860, 1727636, 1305184] aspiring: [790, 650, 652, 496] aspiring: [909, 417, 143, 25, 6] cyclic back to 284: [562, 284, 220] cyclic back to 1184: [1064, 1336, 1184, 1210] non-terminating: [1488, 2480, 3472, 4464, 8432, 9424, 10416, 21328, 22320, 55056, 95728, 96720, 236592, 459792, 881392, 882384, 1474608] non-terminating: [15355717786080, 44534663601120, 144940087464480]
Racket
fold-divisors is used from Proper_divisors#Racket, but for the truly big numbers, we use divisors from math/number-theory.
<lang racket>#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))</lang>
- Output:
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 6) 7: terminating (7 1 0) 8: terminating (8 7 1 0) 9: terminating (9 4 3 1 0) 11: terminating (11 1 0) 12: terminating (12 16 15 9 4 3 1 0) 28: perfect (28 28) 496: perfect (496 496) 220: amicable with 284 (220 284 220) 1184: amicable with 1210 (1184 1210 1184) 12496: sociable length 5 (12496 14288 15472 14536 14264 12496) 1264460: sociable length 4 (1264460 1547860 1727636 1305184 1264460) 790: aspiring to 496 (790 650 652 496 496) 909: aspiring to 6 (909 417 143 25 6 6) 562: cyclic on 284 length 2 (562 284 220 284) 1064: cyclic on 1184 length 2 (1064 1336 1184 1210 1184) 1488: non-terminating long sequence (1488 2480 3472 4464 8432 9424 10416 21328 22320 55056 95728 96720 236592 459792 881392 882384 1474608) 15355717786080: non-terminating big number (15355717786080 44534663601120 144940087464480)
REXX
<lang rexx>/*REXX pgm classifies various positive integers for aliquot sequences. */ parse arg low high L /*get optional arguments*/ high=word(high low 10,1); low=word(low 1,1) /*get the LOW and HIGH. */ if L= then L=11 12 28 496 220 1184 12496 1264460 790 909 562 1064 1488 big=2**47; NTlimit=16+1 /*limit: non-terminating*/ numeric digits max(9, 1+length(big)) /*be able to handle // */ @.=.; @.0=0; @.1=0 /*proper divisor sums. */ say center('numbers from ' low " to " high, 79, "═")
do n=low to high /*process probably some low nums.*/ call classify_aliquot n /*call subroutine to classify it.*/ end /*n*/ /* [↑] process a range of ints.*/
say say center('first numbers for each classification', 79, "═") b.=0 /* [↓] ensure one of each class.*/
do q=1 until b.sociable \== 0 /*only one that has to be counted*/ call classify_aliquot -q /*the minus sign indicates ¬tell.*/ b._=b._+1; if b._==1 then call show_class q,$ /*show 1st found.*/ end /*q*/ /* [↑] until all classes found. */
say say center('classifications for specific numbers', 79, "═")
do i=1 for words(L) /*L is a list of "special numbers*/ call classify_aliquot word(L,i) /*call subroutine to classify it.*/ end /*i*/ /* [↑] process a list of numbers*/
exit /*stick a fork in it, we're done.*/ /*──────────────────────────────────CLASSIFY_ALIQUOT subroutine─────────*/ classify_aliquot: parse arg a 1 aa; a=abs(a) /*get what # to be used.*/ if @.a\==. then s=@.a /*Was number been summed before? */
else s=SPdivs(a) /*No, then do it the hard way. */
@.a=s; $=s /*define sum of the proper DIVs. */ what='terminating' /*assume this classification kind*/ c.=0; c.s=1 /*clear all cyclic seqs, set 1st.*/ if $==a then what='perfect' /*check for "perfect" number. */
else do t=1 while s\==0 /*loop until sum isn't 0 or >big.*/ m=word($, words($)) /*obtain the last number in seq. */ if @.m==. then s=SPdivs(m) /*if ¬defined, then sum Pdivs.*/ else s=@.m /*use the previously found number*/ if m==s & m\==0 then do; what='aspiring' ; leave; end if word($,2)==a then do; what='amicable' ; leave; end $=$ s /*append a sum to number sequence*/ if s==a & t>3 then do; what='sociable' ; leave; end if c.s & m\==0 then do; what='cyclic' ; leave; end c.s=1 /*assign another possible cyclic.*/ /* [↓] Rosetta Code'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 call show_class a,$ /*only display if A is positive.*/ return /*──────────────────────────────────SHOW_CLASS subroutine───────────────*/ show_class: say right(arg(1),digits()) 'is' center(what,15) arg(2); return /*──────────────────────────────────SPDIVS subroutine───────────────────*/ SPdivs: procedure expose @.; parse arg x; if x<2 then return 0; odd=x//2 s=1 /* [↓] use only EVEN|ODD integers*/
do j=2+odd by 1+odd while j*j<x /*divide by all integers up to √x*/ if x//j==0 then s=s+j+ x%j /*add the two divisors to the sum*/ end /*j*/ /* [↑] % is REXX integer divide*/ /* [↓] adjust for square. _ */
if j*j==x then s=s+j /*Was X a square? If so, add √x.*/ @.x=s /*define the sum for the arg X. */ return s /*return divisors (both lists). */</lang> output when using the default input:
════════════════════════════numbers from 1 to 10════════════════════════════ 1 is terminating 0 2 is terminating 1 0 3 is terminating 1 0 4 is terminating 3 1 0 5 is terminating 1 0 6 is perfect 6 7 is terminating 1 0 8 is terminating 7 1 0 9 is terminating 4 3 1 0 10 is terminating 8 7 1 0 ═════════════════════first numbers for each classification═════════════════════ 1 is terminating 0 6 is perfect 6 25 is aspiring 6 138 is non-terminating 150 222 234 312 528 960 2088 3762 5598 6570 10746 13254 13830 19434 20886 21606 25098 26742 26754 220 is amicable 284 220 562 is cyclic 284 220 284 12496 is sociable 14288 15472 14536 14264 12496 ═════════════════════classifications for specific numbers══════════════════════ 11 is terminating 1 0 12 is terminating 16 15 9 4 3 1 0 28 is perfect 28 496 is perfect 496 220 is amicable 284 220 1184 is amicable 1210 1184 12496 is sociable 14288 15472 14536 14264 12496 1264460 is cyclic 1547860 1727636 1305184 1264460 1547860 790 is aspiring 650 652 496 909 is aspiring 417 143 25 6 562 is cyclic 284 220 284 1064 is cyclic 1336 1184 1210 1184 1488 is non-terminating 2480 3472 4464 8432 9424 10416 21328 22320 55056 95728 96720 236592 459792 881392 882384 1474608 2461648 3172912 3173904
Ruby
With proper_divisors#Ruby in place:
<lang ruby>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</lang>
- Output:
terminating: [1, 0] terminating: [2, 1, 0] terminating: [3, 1, 0] terminating: [4, 3, 1, 0] terminating: [5, 1, 0] perfect: [6] terminating: [7, 1, 0] terminating: [8, 7, 1, 0] terminating: [9, 4, 3, 1, 0] terminating: [10, 8, 7, 1, 0] terminating: [11, 1, 0] terminating: [12, 16, 15, 9, 4, 3, 1, 0] perfect: [28] perfect: [496] amicable: [220, 284] amicable: [1184, 1210] sociable of length 5: [12496, 14288, 15472, 14536, 14264] sociable of length 4: [1264460, 1547860, 1727636, 1305184] aspiring: [790, 650, 652, 496] aspiring: [909, 417, 143, 25, 6] cyclic back to 284: [562, 284, 220] cyclic back to 1184: [1064, 1336, 1184, 1210] non-terminating: [1488, 2480, 3472, 4464, 8432, 9424, 10416, 21328, 22320, 55056, 95728, 96720, 236592, 459792, 881392, 882384, 1474608] non-terminating: [15355717786080, 44534663601120, 144940087464480]
Scala
With proper_divisors#Scala /Proper divisors for big (long) numbers/ in place: <lang Scala>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 " "}]" ) }</lang>
- Output:
1 terminate [1 0] 2 terminate [2 1 0] 3 terminate [3 1 0] 4 terminate [4 3 1 0] 5 terminate [5 1 0] 6 perfect [6 6] 7 terminate [7 1 0] 8 terminate [8 7 1 0] 9 terminate [9 4 3 1 0] 10 terminate [10 8 7 1 0] 11 terminate [11 1 0] 12 terminate [12 16 15 9 4 3 1 0] 28 perfect [28 28] 496 perfect [496 496] 220 amicable [220 284 220] 1184 amicable [1184 1210 1184] 12496 sociable-5 [12496 14288 15472 14536 14264 12496] 1264460 sociable-4 [1264460 1547860 1727636 1305184 1264460] 790 aspiring [790 650 652 496 496] 909 aspiring [909 417 143 25 6 6] 562 cyclic-2 [562 284 220 284] 1064 cyclic-2 [1064 1336 1184 1210 1184] 1488 non-term [1488 2480 3472 4464 8432 9424 10416 21328 22320 55056 95728 96720 236592 459792 881392 882384 1474608] 15355717786080 non-term [15355717786080 44534663601120]
zkl
<lang zkl>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();</lang> Or, refactoring to remove saving the intermediate divisors (and adding white space): <lang zkl>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();</lang> <lang zkl>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();
}</lang> <lang zkl>[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() });</lang>
- Output:
L(10,8,7,1,0,0,0,0,0,0,0,0,0,0,0) 1 is terminating L(1) 2 is terminating L(2,1) 3 is terminating L(3,1) 4 is terminating L(4,3,1) 5 is terminating L(5,1) 6 is perfect 7 is terminating L(7,1) 8 is terminating L(8,7,1) 9 is terminating L(9,4,3,1) 10 is terminating L(10,8,7,1) 11 is terminating L(11,1) 12 is terminating L(12,16,15,9,4,3,1) 28 is perfect 496 is perfect 220 is amicable 1184 is amicable 12496 is sociable of length 5 L(12496,14288,15472,14536,14264,12496,14288,15472,14536,14264,12496,14288,15472,14536,14264,12496) 1264460 is sociable of length 4 L(1264460,1547860,1727636,1305184,1264460,1547860,1727636,1305184,1264460,1547860,1727636,1305184,1264460,1547860,1727636,1305184) 790 is aspiring L(790,650,652,496,496,496,496,496,496,496,496,496,496,496,496,496) 909 is aspiring L(909,417,143,25,6,6,6,6,6,6,6,6,6,6,6,6) 562 is cyclic on 284 L(562,284,220,284,220,284,220,284,220,284,220,284,220,284,220,284) 1064 is cyclic on 1184 L(1064,1336,1184,1210,1184,1210,1184,1210,1184,1210,1184,1210,1184,1210,1184,1210) 1488 is non-terminating L(1488,2480,3472,4464,8432,9424,10416,21328,22320,55056,95728,96720,236592,459792,881392,882384)
The loop to calculate 15355717786080 takes forever (literally)