A244052 Highly regular numbers a(n) defined as positions of records in A010846: a(1) = 1 and a(n) is the least number k > a(n-1) such that A010846(k) > A010846(a(n-1)).

1, 2, 4, 6, 10, 12, 18, 24, 30, 42, 60, 84, 90, 120, 150, 180, 210, 330, 390, 420, 630, 840, 1050, 1260, 1470, 1680, 1890, 2100, 2310, 2730, 3570, 3990, 4620, 5460, 6930, 8190, 9240, 10920, 11550, 13650, 13860, 16170, 18480, 20790, 23100, 25410, 27720, 30030, 39270, 43890

Offset

1,2

Comments

Analogous to highly divisible numbers (A002182).

Links

Michael De Vlieger and David A. Corneth, Table of n, a(n) for n = 1..563 (terms 55-149 from David A. Corneth), Mar 08 2017

Example

a(2) = 2 because already for k = 2 A010846(2) = 2 > A010846(1) = 1.
a(3) = 4 because for k = 3 A010846(3) = 2 = A010846(2), but
for k = 4 A010846(4) = 3 > A010846(2) = 2.
a(4) = 6 because for k = 5 A010846(5) = 2 < A010846(4) = 3, but
A010846(6) = 5 > A010846(4) = 3.

Mathematica

Function[w, Map[Position[w, #][[1, 1]] &, Union@ Rest@ FoldList[Max, 0, w]]]@ Table[Count[Range@ n, k_ /; PowerMod[n, Floor@ Log2@ n, k] == 0], {n, 10^3}] (* simplest, or *)
f[n_] := If[n == 1, 1, Length@ Function[w, ToExpression@ StringJoin["Module[{n = ", ToString@ n, ", k = 0}, Flatten@ Table[k++, ", Most@ Flatten@ Map[{#, ", "} &, #], "]]"] &@ MapIndexed[Function[p, StringJoin["{", ToString@ Last@ p, ", 0, Log[", ToString@ First@ p, ", n/(", ToString@ InputForm[Times @@ Map[Power @@ # &, Take[w, First@ #2 - 1]]], ")]}"]]@ w[[First@ #2]] &, w]]@Map[{#, ToExpression["p" <> ToString@ PrimePi@ #]} &, FactorInteger[n][[All, 1]]]]; Function[w, Map[Position[w, #][[1, 1]] &, Union@ Rest@ FoldList[Max, 0, w]]]@ Array[f, 14000] (* Michael De Vlieger, Mar 08 2017, more efficient *)

Prog

(Python)
from itertools import count, islice
from functools import lru_cache
from sympy import primefactors, integer_log
def A244052_gen(): # generator of terms
    c = 1
    yield c
    @lru_cache(maxsize=None)
    def g(x, m, ps): return 1 if x == 1 else sum(g(x//ps[m]**i, m-1, ps) for i in range(integer_log(x, ps[m])[0]+1)) if m else integer_log(x, ps[0])[0]+1
    for n in count(2):
        ps = tuple(sorted(primefactors(n)))
        m = g(n, len(ps)-1, ps)
        if m>c:
            c = m
            yield n
A244052_list = list(islice(A244052_gen(), 50)) # Chai Wah Wu, Apr 05 2026

Crossrefs

Cf. A010846, A002182, A244053.

Sequence in context: A076067 A316460 A065385 * A324059 A055235 A083887

Adjacent sequences: A244049 A244050 A244051 * A244053 A244054 A244055

Keyword

nonn

Author

Michael De Vlieger, Jun 18 2014

Extensions

Edited, giving new name and example. - Wolfdieter Lang, Jun 29 2014

Status

approved