|
%I #41 Mar 09 2017 05:27:14
%S 1,2,4,6,10,12,18,24,30,42,60,84,90,120,150,180,210,330,390,420,630,
%T 840,1050,1260,1470,1680,1890,2100,2310,2730,3570,3990,4620,5460,6930,
%U 8190,9240,10920,11550,13650,13860
%N 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)).
%C Analogous to highly divisible numbers (A002182).
%H Michael De Vlieger and David A. Corneth, <a href="/A244052/b244052.txt">Table of n, a(n) for n = 1..563</a> (terms 55-149 from David A. Corneth), Mar 08 2017
%e a(2) = 2 because already for k = 2 A010846(2) = 2 > A010846(1) = 1.
%e a(3) = 4 because for k = 3 A010846(3) = 2 = A010846(2), but
%e for k = 4 A010846(4) = 3 > A010846(2) = 2.
%e a(4) = 6 because for k = 5 A010846(5) = 2 < A010846(4) = 3, but
%e A010846(6) = 5 > A010846(4) = 3.
%t 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 *)
%t 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 *)
%Y Cf. A010846, A002182, A244053.
%K nonn
%O 1,2
%A _Michael De Vlieger_, Jun 18 2014
%E Edited, giving new name and example. - _Wolfdieter Lang_, Jun 29 2014
|
