Aliquot sequence classifications: Difference between revisions
Content added Content deleted
(jq) |
(Add Haskell - Aliquot sequence classifications) |
||
| Line 108: | Line 108: | ||
Cyclic back to 1184: [1064, 1336, 1184, 1210] |
Cyclic back to 1184: [1064, 1336, 1184, 1210] |
||
Non-terminating: [1488, 2480, 3472, 4464, 8432, 9424, 10416, 21328, 22320, 55056, 95728, 96720, 236592, 459792, 881392, 882384, 1474608]</pre> |
Non-terminating: [1488, 2480, 3472, 4464, 8432, 9424, 10416, 21328, 22320, 55056, 95728, 96720, 236592, 459792, 881392, 882384, 1474608]</pre> |
||
=={{header|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> |
|||
{{out}} |
|||
<pre>(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])</pre> |
|||
=={{header|J}}== |
=={{header|J}}== |
||
Revision as of 06:00, 9 January 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)
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();
fcn classify(k){
const MAX=(2).pow(47);
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)