|
|
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.
|
|
0
|
|
|
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
(list;
graph;
refs;
listen;
history;
text;
internal format)
|
|
|
OFFSET
|
0,2
|
|
COMMENTS
|
Apart from initial 1, it is a subset of A005101.
|
|
LINKS
|
|
|
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
|
|
|
KEYWORD
|
nonn,more
|
|
AUTHOR
|
|
|
EXTENSIONS
|
|
|
STATUS
|
approved
|
|
|
|