A094251 Number of one-element transitions between all set partitions of n labeled elements.

0, 0, 2, 18, 104, 580, 3282, 19236, 117672, 753048, 5041880, 35283402, 257718540, 1961679824, 15534932350, 127788932430, 1090212468512, 9632275777296, 88013486026710, 830637659785996, 8087069127986020, 81132805319035260, 837852685505824120, 8897619270153977254

Offset: 0

Author

Thomas Wieder, Apr 25 2004

Keywords

• nonn

Examples

			a(3) = 18 because there are 18 one-element transitions among the set partitions of n=3 elements ([x,z,y,...] means element 1 belongs to set x, element 2 belongs to set z, element 3 belongs to set y):
[1, 1, 1] -> [1, 1, 2]; [1, 1, 1] -> [1, 2, 1]; [1, 1, 1] -> [1, 2, 2];
[1, 1, 2] -> [1, 1, 1]; [1, 1, 2] -> [1, 2, 1]; [1, 1, 2] -> [1, 2, 2];
[1, 1, 2] -> [1, 2, 3]; [1, 2, 1] -> [1, 1, 1]; [1, 2, 1] -> [1, 1, 2];
[1, 2, 1] -> [1, 2, 2]; [1, 2, 1] -> [1, 2, 3]; [1, 2, 2] -> [1, 1, 1];
[1, 2, 2] -> [1, 1, 2]; [1, 2, 2] -> [1, 2, 1]; [1, 2, 2] -> [1, 2, 3];
[1, 2, 3] -> [1, 1, 2]; [1, 2, 3] -> [1, 2, 1]; [1, 2, 3] -> [1, 2, 2];
		

Links

• Alois P. Heinz, Table of n, a(n) for n = 0..70

Crossrefs

Cf. A093694, A093695.

Programs

Maple

a:= proc(m) local b, r;
      b:= proc(n, i, p, l) local g, h, k;
            if i=0 then if n=0 then g:= l[1]; h:= l[2]; k:= l[3]+g+h;
                r:= r+p*(g*(g-1)/2+g*(k-g)+h*(1+2*(k-1))+(m-g-2*h)*k) fi
          else b(n, i-1, p, `if`(i<3, [0, l[]], l));
               seq(b(n-i*j, i-1, p*n!/(i!)^j/(n-i*j)!/j!,
                   `if`(i<3, [j, l[]], [l[]+j])), j=1..n/i)
            fi
          end;
      r:=0; b(m, max(m, 2), 1, [0]); r
    end:
seq(a(n), n=0..25);  # Alois P. Heinz, Apr 13 2012

Mathematica

a[m_] := Module[{b, r}, b[n_, i_, p_, l_List] := Module[{g, h, k}, If[i == 0, If[n == 0, g = l[[1]]; h = l[[2]]; k = l[[3]] + g + h; r = r + p(g(g - 1)/2 + g(k - g) + h(1 + 2(k - 1)) + (m - g - 2h)k)], b[n, i - 1, p, If[i < 3, Prepend[l, 0], l]]; Table[b[n - i j, i - 1, p n!/(i!)^j/(n - i j)!/j!, If[i < 3, Prepend[l, j], l + j]], {j, 1, n/i}]]]; r = 0; b[m, Max[m, 2], 1, {0}]; r];
a /@ Range[0, 25] (* Jean-François Alcover, Nov 18 2020, after Alois P. Heinz *)

Extensions

a(6)-a(23) from Alois P. Heinz, Apr 12 2012