A127663 Infinitary aspiring numbers.

30, 42, 54, 66, 72, 78, 100, 140, 148, 152, 192, 194, 196, 208, 220, 238, 244, 252, 268, 274, 292, 296, 298, 300, 336, 348, 350, 360, 364, 372, 374, 380, 382, 386, 400, 416, 420, 424, 476, 482, 492, 516, 520, 532, 540, 542, 544, 550, 572, 576, 578, 586, 592

Offset: 1

Author

Ant King, Jan 26 2007

Keywords

• hard
• nonn

Comments

Numbers whose infinitary aliquot sequences end in an infinitary perfect number, but are not infinitary perfect numbers themselves.

Examples

			a(5) = 72 because the fifth non-infinitary perfect number whose infinitary aliquot sequence ends in an infinitary perfect number is 72.
		

Links

• Amiram Eldar, Table of n, a(n) for n = 1..72
• Graeme L. Cohen, On an integer's infinitary divisors, Math. Comp., 54 (1990), 395-411.
• J. O. M. Pedersen, Tables of Aliquot Cycles. [Broken link]
• J. O. M. Pedersen, Tables of Aliquot Cycles. [Via Internet Archive Wayback-Machine]
• J. O. M. Pedersen, Tables of Aliquot Cycles. [Cached copy, pdf file only]

Crossrefs

Cf. A007357, A126168, A127661, A127662, A127664, A127665, A127666, A127667.

Programs

Mathematica

ExponentList[n_Integer,factors_List]:={#,IntegerExponent[n,# ]}&/@factors;InfinitaryDivisors[1]:={1}; InfinitaryDivisors[n_Integer?Positive]:=Module[ { factors=First/@FactorInteger[n], d=Divisors[n] }, d[[Flatten[Position[ Transpose[ Thread[Function[{f,g}, BitOr[f,g]==g][ #,Last[ # ]]]&/@ Transpose[Last/@ExponentList[ #,factors]&/@d]],?(And@@#&),{1}]] ]] ] Null;properinfinitarydivisorsum[k]:=Plus@@InfinitaryDivisors[k]-k;g[n_] := If[n > 0,properinfinitarydivisorsum[n], 0];iTrajectory[n_] := Most[NestWhileList[g, n, UnsameQ, All]];InfinitaryPerfectNumberQ[0]=False;InfinitaryPerfectNumberQ[k_Integer] :=If[properinfinitarydivisorsum[k]==k,True,False];Select[Range[750],InfinitaryPerfectNumberQ[Last[iTrajectory[ # ]]] && !InfinitaryPerfectNumberQ[ # ]&]
f[p_, e_] := Module[{b = IntegerDigits[e, 2]}, m = Length[b]; Product[If[b[[j]] > 0, 1 + p^(2^(m - j)), 1], {j, 1, m}]]; s[n_] := Times @@ f @@@ FactorInteger[n] - n; s[0] = s[1] = 0; q[n_] := Module[{v = NestWhileList[s, n, UnsameQ, All]}, n != v[[-2]] == v[[-1]] > 0]; Select[Range[839], q]  (* Amiram Eldar, Mar 11 2023 *)