A331972 Bi-unitary highly touchable numbers: numbers m > 1 such that a record number of numbers k have m as the sum of the proper bi-unitary divisors of k.

2, 6, 8, 17, 29, 31, 55, 79, 91, 115, 121, 175, 181, 211, 295, 301, 361, 391, 421, 481, 511, 571, 631, 781, 841, 991, 1051, 1231, 1261, 1471, 1561, 1651, 1681, 1891, 2101, 2311, 2731, 3151, 3361, 3571, 3991, 4201, 4291, 4411, 4621, 5251, 5461, 6091, 6511, 6931

Offset: 1

Author

Amiram Eldar, Feb 03 2020

Keywords

• nonn

Comments

The corresponding record values are 0, 1, 2, 3, 4, 6, 8, 9, 10, 11, 14, 15, ...

The bi-unitary version of A238895.

Examples

			a(1) = 2 since it is the first number which is not the sum of proper bi-unitary divisors of any number.
a(2) = 6 since it is the least number which is the sum of proper bi-unitary divisors of one number: 6 = A331970(6).
a(3) = 8 since it is the least number which is the sum of proper bi-unitary divisors of 2 numbers: 8 = A331970(10) = A331970(12).
		

Links

• Amiram Eldar, Table of n, a(n) for n = 1..73 (terms below 30000)

Crossrefs

Cf. A188999, A238895, A324276, A325177, A331970, A331974.

Programs

Mathematica

fun[p_, e_] := If[OddQ[e], (p^(e+1)-1)/(p-1), (p^(e+1)-1)/(p-1)-p^(e/2)]; bsigma[1] = 1; bsigma[n_] := Times @@ (fun @@@ FactorInteger[n]); bs[n_] := bsigma[n] - n; m = 300; v = Table[0, {m}]; Do[b = bs[k]; If[2 <= b <= m, v[[b]]++], {k, 1, m^2}]; s = {}; vm = -1; Do[If[v[[k]] > vm, vm = v[[k]]; AppendTo[s, k]], {k, 2, m}]; s