|
%I #39 Mar 09 2017 05:27:21
%S 1,2,3,5,6,8,10,11,18,19,26,28,32,36,41,44,68,77,80,96,115,131,145,
%T 156,166,174,183,192,283,295,313,322,382,395,452,463,505,519,551,567,
%U 593,629,660,691,717,743,766,1161,1224,1253,1257,1285,1306,1526
%N Let m = A244052(n) = n-th highly regular number; a(n) = number of numbers r <= m, all of whose prime divisors p also divide m.
%C Analogous to A002183.
%C Records transform of A010846. -_Michael De Vlieger_, Mar 08 2017
%H Michael De Vlieger and David A. Corneth, <a href="/A244053/b244053.txt">Table of n, a(n) for n = 1..563</a> (terms 55-149 from David A. Corneth)
%H Michael De Vlieger, <a href="/A244053/a244053.txt">Multiplicities of primes in the prime decomposition of A244052 and values of A244053.</a>
%e a(5) = 6 since 6 is the fifth record value of A010846. The first record value is 1 set at position 1; the second is 2 set at position 2, the third is 3 set at position 4, the fourth is 5 set at position 6. Sequence A244052 records the positions of these record values.
%t a010846[n_] := Block[{pf, a}, a[x_] := First /@ FactorInteger@ x; pf = a@ n; If[n == 1, 1, 1 + Count[Range@ n, _?(SubsetQ[pf, a@ #] &)]]]; f[n_] := Block[{t = {}, max = 0, x}, Do[If[(x = a010846@ i) > max, max = x; AppendTo[t, a010846[i]]], {i, n}]; t]; f@ 1000 (* _Michael De Vlieger_, Feb 10 2015 *)
%t Union@ Rest@ FoldList[Max, 0, Array[Count[Range@ #, k_ /; PowerMod[#, Floor@ Log2@ #, k] == 0] &, 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]]]]; Union@ Rest@ FoldList[Max, 0, Array[f, 10^4]] (* _Michael De Vlieger_, Mar 08 2017, more efficient *)
%Y Cf. A244052, A002183, A010846.
%K nonn
%O 1,2
%A _Michael De Vlieger_, Jun 18 2014
|
