%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