A335371 Harmonic numbers with a record number of harmonic numbers that can be generated from them using an iterative process of multiplying by primes (see Comments).

1, 28, 1638, 6200, 950976, 2178540, 2457000, 4713984, 45532800, 142990848, 459818240, 1381161600, 10200236032, 57575890944, 109585986048, 513480135168, 1553357978368, 10881843388416, 43947421401888

Offset: 1

Author

Amiram Eldar, Jun 03 2020

Keywords

• nonn
• more

Comments

If m is a harmonic number (A001599), then it is possible to generate a new harmonic number m*p if p is a prime number that does not divide m and (p+1)/2 is a divisor of the harmonic mean of the divisors of m, h(m) = m * tau(m)/sigma(m) = m * A000005(m)/A000203(m).

Given a harmonic number m, in the first iteration a finite set of new harmonic numbers, {m*p_1, m*p_2, ...} is being generated. In the second iteration, a new set of harmonic number is being generated from each of the harmonic numbers from the previous iteration, a union of these sets is be calculated (removing duplicates). The process is terminated when no more harmonic numbers can be generated. The total number of harmonic numbers from all the iterations is being counted. The terms of this sequence have a record count of new harmonic numbers.

The corresponding record values of k are 0, 1, 3, 5, 8, 12, 17, 36, 38, 40, 44, 62, 70, 82, 156, 226, 281, 335, 358, ...

Examples

			1638 is a term since a record number of 3 new harmonic numbers can be generated from it. In the first iteration 2 new harmonic numbers can be generated: 1638 * 5 = 8190, and 1638 * 17 = 27846. In the second iteration, a new harmonic number can be generated from 8190: 8190 * 29 = 237510.
		

Crossrefs

Cf. A000005, A000203, A001599, A099377, A099378, A335368, A335369, A335370.

Programs

Mathematica

harmNums = Cases[Import["https://oeis.org/A001599/b001599.txt", "Table"], {, }][[;; , 2]]; harMean[n_] := n * DivisorSigma[0, n]/DivisorSigma[1, n]; harmGen[n_] := Module[{d = Divisors[harMean[n]]}, n * Select[2*d - 1, PrimeQ[#] && ! Divisible[n, #] &]]; harmGens[s_] := Union@Flatten[harmGen /@ s]; lenmax = -1; seq = {}; Do[len = Length @ Union @ Flatten @ FixedPointList[harmGens, {harmNums[[k]]}]; If[len > lenmax, lenmax = len; AppendTo[seq, harmNums[[k]]]], {k, 1, Length[harmNums]}]; seq