A127661 Lengths of the infinitary aliquot sequences.
2, 3, 3, 3, 3, 1, 3, 4, 3, 5, 3, 5, 3, 6, 4, 3, 3, 6, 3, 6, 4, 7, 3, 8, 3, 4, 4, 6, 3, 6, 3, 4, 5, 7, 4, 7, 3, 8, 4, 8, 3, 5, 3, 4, 5, 5, 3, 7, 3, 7, 5, 7, 3, 4, 4, 6, 4, 5, 3, 1, 3, 8, 4, 5, 4, 3, 3, 8, 5, 10, 3, 3, 3, 9, 4, 9, 4, 2, 3, 8, 3, 5, 3, 10, 4, 6, 6, 8, 3, 1, 5, 7, 5, 8, 4, 9, 3, 8, 5, 7
Offset: 1
Keywords
Examples
a(4)=3 because the infinitary aliquot sequence generated by 4 is 4 -> 1 -> 0 and it has length 3. a(6) = 1 because 6 -> 6 -> 6 ->... enters a cycle after 1 term. a(8) = 4 because 8 -> 7 -> 1 -> 0 terminates after 4 terms. a(30) = 6 because 30 ->42 -> 54 -> 66 -> 78 -> 90 -> 90 -> 90 -> ...enters a cycle after 6 terms. a(126)=2 because 126 -> 114 -> 126 enters a cycle after 2 terms.
Links
- R. J. Mathar, Table of n, a(n) for n = 1..839
- Graeme L. Cohen, On an integer's infinitary divisors, Math. Comp., 54 (1990), 395-411.
- Hans Havermann, Graphs of infinitary aliquot sequences for 840, 1152, 2442, 2658, 2982, 5766, 6216, 6870, 7560, 8670, 9030, 9570 (click to see full plots)
- D. Moews, A database of aliquot cycles (2015)
- 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]
Programs
-
Maple
# Uses code snippets of A049417 A127661 := proc(n) local trac,x; x := n ; trac := [x] ; while true do x := A049417(x)-trac[-1] ; if x = 0 then return 1+nops(trac) ; elif x in trac then return nops(trac) ; end if; trac := [op(trac),x] ; end do: end proc: seq(A127661(n),n=1..100) ; # R. J. Mathar, Oct 05 2017
-
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}]] ]] ]; properinfinitarydivisorsum[k]:=Plus@@InfinitaryDivisors[k]-k;g[n_] := If[n > 0,properinfinitarydivisorsum[n], 0];iTrajectory[n_] := Most[NestWhileList[g, n, UnsameQ, All]];Length[iTrajectory[ # ]] &/@ Range[100] (* Second program: *) A049417[n_] := If[n == 1, 1, Sort@ Flatten@ Outer[Times, Sequence @@ (FactorInteger[n] /. {p_, m_Integer} :> p^Select[Range[0, m], BitOr[m, #] == m &])]] // Total; A127661[n_] := Module[{trac, x}, x = n; trac = {x}; While[True, x = A049417[x] - trac[[-1]]; If[x == 0, Return[1 + Length[trac]], If[MemberQ[trac, x], Return[Length[trac]]]]; trac = Append[trac, x]]]; Table[A127661[n], {n, 1, 100}] (* Jean-François Alcover, Aug 28 2023, after R. J. Mathar *)
Comments