A286659 Check the abundance of a number and iterate the test replacing at every step the sum of the divisors of the previous number. Sequence lists the least numbers whose abundances last n steps.

1, 12, 30, 104, 88, 40, 24, 402, 228, 260, 150, 3912, 82860, 55680, 21210, 21336, 7872, 3276, 1170, 360, 120, 54, 5860, 2502528, 660660, 225576, 104094, 107091522

Offset

0,2

Comments

Apart from initial 1, it is a subset of A005101.

Links

Table of n, a(n) for n=0..27.

Example

a(0) = 1 because it is the first deficient number;
a(1) = 12 because sigma(12) = 28 > 2*12 and sigma(28) = 56 = 2*28 and it is the least number to have this property;
a(2) = 30 because sigma(30) = 72 > 2*30, sigma(72) = 195 > 2*72 and sigma(195) = 336 < 2*195 and it is the least number to have this property; etc.

Maple

with(numtheory): P:= proc(q) local a, j, k, ok, n, p; for j from 1 to q do
for n from 1 to q do if sigma(n)>2*n then a:=n; ok:=1;
for k from 1 to j do if sigma(a)>2*a then a:=sigma(a); else ok:=0; break; fi; od;
if ok=1 then if sigma(a)<=2*a then lprint(j, n); break; fi; fi;
fi; od; od; end: P(10^6);

Mathematica

With[{nn = 30}, Function[s, Function[t, ReplacePart[t, Map[If[KeyExistsQ[s, #], # + 1 -> -1 + First@ Lookup[s, #], # + 1 -> -1] &, Range[0, Length@ t]]]]@ConstantArray[0, Max@ Evaluate@ Keys@ s]]@ Rest@ KeySort@ PositionIndex[Table[NestWhileList[{DivisorSigma[1, #1], 2 #1, #3 + 1} & @@ # &, {n, n/2, 0}, And[#1 > #2, #3 < nn] & @@ # &][[-1, -1]], {n, 0, 10^5}] /. k_ /; k == nn -> -1]] (* Michael De Vlieger, May 12 2017, Version 10 *)

Crossrefs

Cf. A005101.

Sequence in context: A301775 A175157 A371075 * A320483 A361468 A361467

Adjacent sequences: A286656 A286657 A286658 * A286660 A286661 A286662

Keyword

nonn,more

Author

Paolo P. Lava, May 12 2017

Extensions

a(27) from Giovanni Resta, May 12 2017

Status

approved