OFFSET
1,2
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, ...
EXAMPLE
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.
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
CROSSREFS
KEYWORD
nonn,more
AUTHOR
Amiram Eldar, Jun 03 2020
STATUS
approved