login
Numbers that start an unbounded aliquot-like sequence based on Dedekind psi function (A001615).
4

%I #9 Mar 15 2024 18:43:28

%S 318,330,498,510,534,546,636,660,786,798,942,954,978,990,996,1020,

%T 1068,1092,1110,1122,1254,1272,1320,1398,1410,1470,1494,1506,1518,

%U 1530,1572,1596,1602,1614,1626,1638,1734,1884,1908,1938,1950,1956,1980,1992,2040,2046

%N Numbers that start an unbounded aliquot-like sequence based on Dedekind psi function (A001615).

%C Let t(k) = psi(k) - k = A001615(k) - k be the sum of aliquot divisors d of k, such that k/d is squarefree. Penney & Pomerance proposed a problem to show that the aliquot-like sequence related to this function, i.e., the trajectory of an integer k under the repeated application of the map k -> t(k), can be unbounded. Since t(m^j * k) = m^j * t(k) if m|k, then if in the sequence a_0 = k, a_1 = t(k), a_2 = t(t(k)), ... there is a term a_{i1} = m^j * a_0 such that m|k and j > 0 then a_{i+i1} = m^j * a_i for all i and thus the sequence is unbounded.

%D Jean-Marie De Koninck, Those Fascinating Numbers, Amer. Math. Soc., 2009, page 71, entry 318.

%H Kevin Brown and Charles Vanden Eynden, <a href="https://www.jstor.org/stable/2974888">Pseudo-aliquot Sequences, Solution to Problem 10323</a>, The American Mathematical Monthly, Volume 103, No. 8 (1996), pp. 697-698.

%H David E. Penney and Carl Pomerance, <a href="https://www.jstor.org/stable/10.2307/2323896">Problem 10323</a>, The American Mathematical Monthly, Volume 100, No. 7 (1993), p. 688.

%H Eric Weisstein's World of Mathematics, <a href="http://mathworld.wolfram.com/AliquotSequence.html">Aliquot Sequence</a>.

%H Wikipedia, <a href="http://en.wikipedia.org/wiki/Aliquot_sequence">Aliquot sequence</a>.

%e 318 is in the sequence since t(318) = psi(318) - 318 = 330, t(330) = 534, etc., and this repeated mapping yields an unbounded sequence.

%t t[1]=0; t[n_] := (Times@@(1+1/Transpose[FactorInteger[n]][[1]])-1)*n; rt[n_] := Module[{f=FactorInteger[n]}, e=GCD@@f[[;;,2]]; Surd[n,e]]; divrootQ[n_, m_] := Divisible[n, rt[m]]; divQ[s_, n_] := If[n==0, 0, If[MemberQ[s, n], 1, If[ Length[Select[s, Divisible[n,#] && divrootQ[#, n/#] &]] > 0, 2, 3]]]; seqQ[n_] := Module[{n1=n}, s={}; While[divQ[s, n1] ==3, AppendTo[s, n1]; n1=t[n1]]; divQ[s, n1]] == 2; Select[Range[10000], seqQ]

%Y Cf. A001615, A098007, A187778.

%K nonn

%O 1,1

%A _Amiram Eldar_, Jan 11 2019