|
%I #29 May 02 2024 16:53:42
%S 1,1,2,1,6,14,1,18,78,230,1,54,426,1902,6902,1,162,2286,15402,76110,
%T 329462,1,486,12090,122190,822954,4553166,22934774,1,1458,63198,
%U 951546,8724078,61796298,381523758,2193664790,1,4374,327306,7290942,90768378,823457454,6241779786,42700751022,276054834902
%N Number A(n,k) of acyclic orientations of the complete tripartite graph K_{n,n,k}; square array A(n,k), n>=0, k>=0, read by antidiagonals.
%C An acyclic orientation is an assignment of a direction to each edge such that no cycle in the graph is consistently oriented. Stanley showed that the number of acyclic orientations of a graph G is equal to the absolute value of the chromatic polynomial X_G(q) evaluated at q=-1.
%H Alois P. Heinz, <a href="/A372254/b372254.txt">Rows n = 0..140, flattened</a>
%H Don Knuth, <a href="http://cs.stanford.edu/~knuth/papers/poly-Bernoulli.pdf">Parades and poly-Bernoulli bijections</a>, Mar 31 2024. See (19.2).
%H Richard P. Stanley, <a href="http://dx.doi.org/10.1016/0012-365X(73)90108-8">Acyclic Orientations of Graphs</a>, Discrete Mathematics, 5 (1973), pages 171-178, doi:10.1016/0012-365X(73)90108-8
%H Wikipedia, <a href="https://en.wikipedia.org/wiki/Acyclic_orientation">Acyclic orientation</a>
%H Wikipedia, <a href="https://en.wikipedia.org/wiki/Multipartite_graph">Multipartite graph</a>
%e Square array A(n,k) begins:
%e 1, 1, 1, 1, 1, 1, ...
%e 2, 6, 18, 54, 162, 486, ...
%e 14, 78, 426, 2286, 12090, 63198, ...
%e 230, 1902, 15402, 122190, 951546, 7290942, ...
%e 6902, 76110, 822954, 8724078, 90768378, 928340190, ...
%e 329462, 4553166, 61796298, 823457454, 10779805722, 138779942046, ...
%p g:= proc(n) option remember; `if`(n=0, 1, add(
%p expand(x*g(n-j))*binomial(n-1, j-1), j=1..n))
%p end:
%p A:= proc(n, k) option remember; local q, l, b; q, l, b:= -1, [n$2, k],
%p proc(n, j) option remember; `if`(j=1, mul(q-i, i=0..n-1)*
%p (q-n)^l[1], add(b(n+m, j-1)*coeff(g(l[j]), x, m), m=0..l[j]))
%p end; abs(b(0, 3))
%p end:
%p seq(seq(A(n, d-n), n=0..d), d=0..9);
%t g[n_] := g[n] = If[n == 0, 1, Sum[Expand[x*g[n-j]]*Binomial[n-1, j-1], {j, 1, n}]];
%t A[n_, k_] := A[n, k] = Module[{q, l, b}, {q, l} = {-1, {n, n, k}}; b[n0_, j_] := b[n0, j] = If[j == 1, Product[q-i, {i, 0, n0-1}]*(q-n0)^l[[1]], Sum[b[n0 + m, j-1]*Coefficient[g[l[[j]]], x, m], {m, 0, l[[j]]}]]; Abs[b[0, 3]]];
%t Table[Table[A[n, d-n], {n, 0, d}], {d, 0, 9}] // Flatten (* _Jean-François Alcover_, Apr 25 2024, after _Alois P. Heinz_ *)
%Y Rows n=0-2 give: A000012, A008776, A370960.
%Y Column k=0 gives A048163(n+1).
%Y Main diagonal gives A370961.
%Y Cf. A212220, A267383, A372261.
%K nonn,tabl,new
%O 0,3
%A _Alois P. Heinz_, Apr 24 2024
|
