A263344 Consider the abundant aliquot parts, in ascending order, of a composite number. Take their sum and repeat the process deleting the minimum number and adding the previous sum. The sequence lists the numbers that after some number of iterations reach a sum equal to themselves.

1700, 5950, 155574, 274550, 300894, 715275, 758625, 1365234, 1404172, 1542500, 1661750, 2095250, 2239750, 2673250, 2962250, 3106750, 3395750, 3829250, 4226625, 4262750, 4407250, 4700619, 5398750, 6371092, 8167635, 8560024, 12305620, 13725855, 15497625, 15586263

Offset

1,1

Links

Table of n, a(n) for n=1..30.

Example

Aliquot parts of 1700 are 1, 2, 4, 5, 10, 17, 20, 25, 34, 50, 68, 85, 100, 170, 340, 425, 850. The abundant numbers are 20, 100, 340. Therefore:
20 + 100 + 340 = 460;
100 + 340 + 460 = 900;
340 + 460 + 900 = 1700.

Maple

with(numtheory):P:=proc(q, h) local a, b, k, t, v; global n; v:=array(1..h);
for n from 1 to q do if not isprime(n) then b:=sort([op(divisors(n))]); a:=[];
for k from 1 to nops(b)-1 do if sigma(b[k])>2*b[k] then a:=[op(a), b[k]]; fi; od;
a:=sort(a); b:=nops(a); if b>1 then for k from 1 to b do v[k]:=a[k]; od;
t:=b+1; v[t]:=add(v[k], k=1..b); while v[t]<n do t:=t+1; v[t]:=add(v[k], k=t-b..t-1);
od; if v[t]=n then lprint(n, a); fi; fi; fi; od; end: P(10^9, 1000);

Mathematica

seqQ[n_] := Module[{d = Select[Most[Divisors[n]], DivisorSigma[1, #] > 2 # &]}, Switch[Length[d], _?(# < 1 &), False, _?(# == 1 &), d[[1]] == n, _, k = 0; While[k < n, k = Total[d]; d = Rest[AppendTo[d, k]]]; k == n]]; seq = {}; Do[ If[seqQ[n], AppendTo[seq, n]], {n, 2, 10^6}]; seq (* Amiram Eldar, Mar 20 2019 *)

Crossrefs

Cf. A005101 (abundant numbers), A027751 (aliquot parts), A246544, A247012, A258142, A258270.

Sequence in context: A083610 A020405 A091368 * A159464 A166400 A210121

Adjacent sequences: A263341 A263342 A263343 * A263345 A263346 A263347

Keyword

nonn

Author

Paolo P. Lava, Oct 15 2015

Extensions

More terms from Amiram Eldar, Mar 20 2019

Status

approved