login
Irregular triangle where row n contains indices k where the product of A002110(k) = A025487(n).
6

%I #19 Dec 30 2019 19:49:25

%S 0,1,1,1,2,1,1,1,1,2,1,1,1,1,1,1,2,3,1,1,1,1,1,2,2,1,1,1,2,1,3,1,1,1,

%T 1,1,1,1,2,2,1,1,1,1,2,1,1,3,1,1,1,1,1,1,1,1,1,2,2,2,3,1,1,1,1,1,2,4,

%U 2,2,2,1,1,1,3,1,1,1,1,1,1,1,1,1,1,1,2,2

%N Irregular triangle where row n contains indices k where the product of A002110(k) = A025487(n).

%C Row n consists of terms k such that A025487(n) = the product of primorials p_k#, the k in row n written least to greatest k.

%C For m = A025487(n) in A000079 (i.e., m is an integer power of 2), row n contains A000079(m) 1s.

%C For m = A025487(n) in A002110 (i.e., m is a primorial) row n contains a single term k that is the index of m in A002110.

%H Michael De Vlieger, <a href="/A304886/b304886.txt">Table of n, a(n) for n = 1..8600</a>

%H Michael De Vlieger, <a href="/A304886/a304886.txt">Concordance of A025487, A051282, A061394, and A304886</a>

%H Michael De Vlieger, <a href="/A304886/a304886_1.txt">Indices of primorials whose product is highly composite</a>

%H Michael De Vlieger, <a href="/A304886/a304886_2.txt">Indices of primorials whose product is superabundant</a>

%F For row n > 1, Product_{k=1..A051282(n)} A000040(T(n,k)) = A181815(n). [Product of primes indexed by nonzero terms of row n is equal to A181815(n)] - _Antti Karttunen_, Dec 28 2019

%e Triangle begins as in rightmost column, which lists the terms that occur on row n. Maximum value of each row is given by A061394(n).

%e n A025487(n) Row n

%e --------------------------------

%e 1 1 0

%e 2 2 1

%e 3 4 1,1

%e 4 6 2

%e 5 8 1,1,1

%e 6 12 1,2

%e 7 16 1,1,1,1

%e 8 24 1,1,2

%e 9 30 3

%e 10 32 1,1,1,1,1

%e 11 36 2,2

%e 12 48 1,1,1,2

%e 13 60 1,3

%e 14 64 1,1,1,1,1,1

%e 15 72 1,2,2

%e 16 96 1,1,1,1,2

%e 17 120 1,1,3

%e 18 128 1,1,1,1,1,1,1

%e 19 144 1,1,2,2

%e 20 180 2,3

%e ...

%t (* Simple (A025487(n) < 10^5): *)

%t {{0}}~Join~Map[With[{w = #}, Reverse@ Array[Function[k, Count[w, _?(# >= k &)] ], Max@ w]] &, Select[Array[{#, FactorInteger[#][[All, -1]]} &, 400], Times @@ Boole@ {#1 == Times @@ MapIndexed[Prime[First@ #2]^#1 &, #3], #2 == #3} == 1 & @@ {#1, #2, Sort[#2, Greater]} & @@ # &][[All, -1]] ]

%t (* Efficient (A025487(n) < 10^23): *)

%t f[n_] := Block[{ww, g, h},

%t g[x_] := Apply[Times,

%t MapIndexed[Prime[First@ #2]^#1 &, x]];

%t h[x_] := Reverse@

%t Array[Function[k, Count[x, _?(# >= k &)] ], Max@ x];

%t ww = NestList[Append[#, 1] &, {1}, # - 1] &[-2 +

%t Length@ NestWhileList[NextPrime@ # &, 1,

%t Times @@ {##} <= n &, All] ];

%t Map[h, SortBy[Flatten[#, 1], g]] &@

%t Map[Block[{w = #, k = 1},

%t Apply[

%t Join, {{ConstantArray[1, Length@ w]},

%t If[Length@ # == 0, #, #[[1]]] }] &@ Reap[

%t Do[

%t If[# < n,

%t Sow[w]; k = 1,

%t If[k >= Length@ w, Break[], k++]] &@

%t g@ Set[w,

%t If[k == 1,

%t MapAt[# + 1 &, w, k],

%t PadLeft[#, Length@ w, First@ #] &@

%t Drop[MapAt[# + Boole[i > 1] &, w, k],

%t k - 1] ]], {i, Infinity}] ][[-1]] ] &, ww]]; {{0}}~Join~f@ 400

%Y Cf. A025487, A051282 (row lengths), A061394 (row maximum), A124832, A181815.

%Y Cf. also A307056.

%K nonn,tabf

%O 1,5

%A _Michael De Vlieger_, May 21 2018