Location via proxy:   [ UP ]  
[Report a bug]   [Manage cookies]                
A127663
Infinitary aspiring numbers.
3
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,1
COMMENTS
Numbers whose infinitary aliquot sequences end in an infinitary perfect number, but are not infinitary perfect numbers themselves.
LINKS
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]
EXAMPLE
a(5) = 72 because the fifth non-infinitary perfect number whose infinitary aliquot sequence ends in an infinitary perfect number is 72.
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 *)
KEYWORD
hard,nonn
AUTHOR
Ant King, Jan 26 2007
STATUS
approved