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,1

Comments

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

The bi-unitary version of A238895.

Links

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

Example

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).

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

Crossrefs

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

Sequence in context: A331974 A137848 A182629 * A183212 A360264 A325686

Adjacent sequences: A331969 A331970 A331971 * A331973 A331974 A331975

Keyword

nonn

Author

Amiram Eldar, Feb 03 2020

Status

approved