|
%I #23 Feb 03 2017 09:20:42
%S 1,2,4,1,8,2,16,4,1,32,10,2,64,20,5,1,128,44,12,2,256,93,29,6,1,512,
%T 198,63,14,2,1024,414,146,37,7,1,2048,864,329,88,16,2,4096,1788,722,
%U 218,49,8,1,8192,3687,1613,515,118,19,2,16384,7541,3505,1226,313,62,9,1
%N Number T(n,k) of subsets of {1,...,n} containing n and having at least one set partition into k blocks with equal element sum; triangle T(n,k), n>=1, 1<=k<=floor((n+1)/2), read by rows.
%H Alois P. Heinz, <a href="/A248112/b248112.txt">Rows n = 0..24, flattened</a>
%e T(7,3) = 5: {2,3,4,5,7}-> 25/34/7, {1,3,4,6,7}-> 16/34/7, {1,2,5,6,7}-> 16/25/7, {1,2,3,5,6,7}-> 17/26/35, {2,3,4,5,6,7}-> 27/36/45.
%e T(8,4) = 2: {1,2,3,5,6,7,8}-> 17/26/35/8, {1,2,3,4,5,6,7,8}-> 18/27/36/45.
%e T(9,5) = 1: {1,2,3,5,6,7,8,9}-> 18/27/36/45/9.
%e Triangle T(n,k) begins:
%e 01 : 1;
%e 02 : 2;
%e 03 : 4, 1;
%e 04 : 8, 2;
%e 05 : 16, 4, 1;
%e 06 : 32, 10, 2;
%e 07 : 64, 20, 5, 1;
%e 08 : 128, 44, 12, 2;
%e 09 : 256, 93, 29, 6, 1;
%e 10 : 512, 198, 63, 14, 2;
%e 11 : 1024, 414, 146, 37, 7, 1;
%e 12 : 2048, 864, 329, 88, 16, 2;
%p b:= proc(l, i) option remember; local k, r, j;
%p k, r:= nops(l), {};
%p if i*(i+1)/2 < l[-1]*k-add(j, j=l) then r
%p elif i=0 then {r}
%p else for j to k do r:= r union map(y->y union {i}, b((p->
%p map(x->x-p[1], p))(sort(subsop(j=l[j]+i, l))), i-1))
%p od;
%p r union b(l, i-1)
%p fi
%p end:
%p A:= (n, k)-> `if`(k=1, 2^(n-1), nops(b([0$(k-1), n], n-1))):
%p seq(seq(A(n, k), k=1..iquo(n+1, 2)), n=1..15);
%t b[l_, i_] := b[l, i] = Module[{k, r, j}, {k, r} = {Length[l], {}}; Which[ i*(i+1)/2 < l[[-1]]*k - Total[l], r, i == 0, {r}, True, For[j = 1, j <= k, j++, r = r ~Union~ Map[# ~Union~ {i}&, b[Function[p, Map[#-p[[1]]&, p] ][Sort[ReplacePart[l, j -> l[[j]]+i]]], i-1]]]; r ~Union~ b[l, i-1]]]; A[n_, k_] := If[k==1, 2^(n-1), Length[b[Append[Array[0&, (k-1)], n], n-1] ]]; Table[A[n, k], {n, 1, 15}, {k, 1, Quotient[n+1, 2]}] // Flatten (* _Jean-François Alcover_, Feb 03 2017, Translated from Maple *)
%Y Columns k=1-10 give: A000079(n-1), A232466, A232534, A248113, A248114, A248115, A248116, A248117, A248118, A248119.
%K nonn,tabf
%O 1,2
%A _Alois P. Heinz_, Oct 01 2014
|
