A094251 - OEIS

%I #18 Nov 18 2020 06:50:22

%S 0,0,2,18,104,580,3282,19236,117672,753048,5041880,35283402,257718540,

%T 1961679824,15534932350,127788932430,1090212468512,9632275777296,

%U 88013486026710,830637659785996,8087069127986020,81132805319035260,837852685505824120,8897619270153977254

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

%H Alois P. Heinz, <a href="/A094251/b094251.txt">Table of n, a(n) for n = 0..70</a>

%e 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):

%e [1, 1, 1] -> [1, 1, 2]; [1, 1, 1] -> [1, 2, 1]; [1, 1, 1] -> [1, 2, 2];

%e [1, 1, 2] -> [1, 1, 1]; [1, 1, 2] -> [1, 2, 1]; [1, 1, 2] -> [1, 2, 2];

%e [1, 1, 2] -> [1, 2, 3]; [1, 2, 1] -> [1, 1, 1]; [1, 2, 1] -> [1, 1, 2];

%e [1, 2, 1] -> [1, 2, 2]; [1, 2, 1] -> [1, 2, 3]; [1, 2, 2] -> [1, 1, 1];

%e [1, 2, 2] -> [1, 1, 2]; [1, 2, 2] -> [1, 2, 1]; [1, 2, 2] -> [1, 2, 3];

%e [1, 2, 3] -> [1, 1, 2]; [1, 2, 3] -> [1, 2, 1]; [1, 2, 3] -> [1, 2, 2];

%p a:= proc(m) local b, r;

%p       b:= proc(n, i, p, l) local g, h, k;

%p             if i=0 then if n=0 then g:= l[1]; h:= l[2]; k:= l[3]+g+h;

%p                 r:= r+p*(g*(g-1)/2+g*(k-g)+h*(1+2*(k-1))+(m-g-2*h)*k) fi

%p           else b(n, i-1, p, `if`(i<3, [0, l[]], l));

%p                seq(b(n-i*j, i-1, p*n!/(i!)^j/(n-i*j)!/j!,

%p                    `if`(i<3, [j, l[]], [l[]+j])), j=1..n/i)

%p             fi

%p           end;

%p       r:=0; b(m, max(m, 2), 1, [0]); r

%p     end:

%p seq(a(n), n=0..25);  # _Alois P. Heinz_, Apr 13 2012

%t 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];

%t a /@ Range[0, 25] (* _Jean-François Alcover_, Nov 18 2020, after _Alois P. Heinz_ *)

%Y Cf. A093694, A093695.

%K nonn

%O 0,3

%A _Thomas Wieder_, Apr 25 2004

%E a(6)-a(23) from _Alois P. Heinz_, Apr 12 2012