login
Infinitary highly touchable numbers: numbers m > 1 such that a record number of numbers k have m as the sum of the proper infinitary divisors of k.
4

%I #10 Feb 04 2020 03:56:41

%S 2,6,8,17,21,37,49,55,67,79,85,91,121,151,175,181,211,295,301,361,391,

%T 421,481,511,571,631,781,841,991,1051,1231,1261,1471,1561,1651,1681,

%U 1891,2101,2311,2731,3151,3361,3571,3991,4201,4291,4411,4621,5251,5461,6091

%N Infinitary highly touchable numbers: numbers m > 1 such that a record number of numbers k have m as the sum of the proper infinitary divisors of k.

%C The corresponding record values are 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, ...

%C The infinitary version of A238895.

%H Amiram Eldar, <a href="/A331974/b331974.txt">Table of n, a(n) for n = 1..76</a> (terms below 30000)

%e a(1) = 2 since it is the first number which is not the sum of proper infinitary divisors of any number.

%e a(2) = 6 since it is the least number which is the sum of proper infinitary divisors of one number: 6 = A126168(6).

%e a(3) = 8 since it is the least number which is the sum of proper infinitary divisors of 2 numbers: 8 = A126168(10) = A126168(12).

%t fun[p_, e_] := Module[{b = IntegerDigits[e, 2], m}, m = Length[b]; Product[If[b[[j]] > 0, 1 + p^(2^(m - j)), 1], {j, 1, m}]]; isigma[1] = 1; isigma[n_] := Times @@ (fun @@@ FactorInteger[n]); is[n_] := isigma[n] - n; m = 300; v = Table[0, {m}]; Do[i = is[k]; If[2 <= i <= m, v[[i]]++], {k, 1, m^2}]; s = {}; vm = -1; Do[If[v[[k]] > vm, vm = v[[k]]; AppendTo[s, k]], {k, 2, m}]; s

%Y Cf. A049417, A077609, A126168, A238895, A324277, A325177, A331972, A331973.

%K nonn

%O 1,1

%A _Amiram Eldar_, Feb 03 2020