%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