A275714
Number T(n,k) of set partitions of [n] into k blocks with equal element sum; triangle T(n,k), n>=0, 0<=k<=ceiling(n/2), read by rows.
Original entry on oeis.org
1, 0, 1, 0, 1, 0, 1, 1, 0, 1, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 4, 0, 1, 0, 1, 7, 3, 1, 0, 1, 0, 9, 0, 1, 0, 1, 0, 0, 0, 1, 0, 1, 35, 43, 0, 0, 1, 0, 1, 62, 102, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 1, 0, 1, 0, 595, 0, 68, 0, 1, 0, 1, 361, 1480, 871, 187, 17, 0, 1
Offset: 0
T(8,1) = 1: 12345678.
T(8,2) = 7: 12348|567, 12357|468, 12456|378, 1278|3456, 1368|2457, 1458|2367, 1467|2358.
T(8,3) = 3: 1236|48|57, 138|246|57, 156|237|48.
T(8,4) = 1: 18|27|36|45.
T(9,3) = 9: 12345|69|78, 1239|456|78, 1248|357|69, 1257|348|69, 1347|258|69, 1356|249|78, 159|2346|78, 168|249|357, 159|267|348.
Triangle T(n,k) begins:
00 : 1;
01 : 0, 1;
02 : 0, 1;
03 : 0, 1, 1;
04 : 0, 1, 1;
05 : 0, 1, 0, 1;
06 : 0, 1, 0, 1;
07 : 0, 1, 4, 0, 1;
08 : 0, 1, 7, 3, 1;
09 : 0, 1, 0, 9, 0, 1;
10 : 0, 1, 0, 0, 0, 1;
11 : 0, 1, 35, 43, 0, 0, 1;
12 : 0, 1, 62, 102, 0, 0, 1;
13 : 0, 1, 0, 0, 0, 0, 0, 1;
14 : 0, 1, 0, 595, 0, 68, 0, 1;
15 : 0, 1, 361, 1480, 871, 187, 17, 0, 1;
-
Needs["Combinatorica`"]; T[n_, k_] := Count[(Equal @@ (Total /@ #)&) /@ KSetPartitions[n, k], True]; Table[row = Table[T[n, k], {k, 0, Ceiling[n/2]}]; Print[n, " ", row]; row, {n, 0, 12}] // Flatten (* Jean-François Alcover, Jan 20 2017 *)
A327449
Number of ways the first n primes can be partitioned into three sets with equal sums.
Original entry on oeis.org
0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 423, 0, 2624, 0, 13474, 0, 0, 0, 611736, 0, 4169165, 0, 30926812, 0, 214975174, 0, 1590432628, 0, 11431365932, 0, 83946004461, 0, 0, 0, 4615654888831, 0, 35144700468737, 0, 271133285220726, 0, 2103716957561013, 0, 0, 0, 0, 0, 990170108748552983, 0, 7855344215856348141
Offset: 1
One of the three solutions for n = 10: 3 + 17 + 23 = 2 + 5 + 7 + 29 = 11 + 13 + 19.
- Keith F. Lynch, Posting to Math Fun Mailing List, Sep 17 2019.
-
s:= proc(n) option remember; `if`(n<2, 0, ithprime(n)+s(n-1)) end:
b:= proc(n, x, y) option remember; `if`(n=1, 1, (p-> (l->
add(`if`(p>l[i], 0, b(n-1, sort(subsop(i=l[i]-p, l))
[1..2][])), i=1..3))([x, y, s(n)-x-y]))(ithprime(n)))
end:
a:= n-> `if`(irem(2+s(n), 3, 'q')=0, b(n, q-2, q)/2, 0):
seq(a(n), n=1..40); # Alois P. Heinz, Sep 19 2019
-
s[n_] := s[n] = If[n < 2, 0, Prime[n] + s[n - 1]];
b[n_, x_, y_] := b[n, x, y] = If[n == 1, 1, Function[p, Function[l, Sum[If[ p > l[[i]], 0, b[n - 1, Sequence @@ Sort[ReplacePart[l, i -> l[[i]] - p]][[1;; 2]]]], {i, 1, 3}]][{x, y, s[n] - x - y}]][Prime[n]]];
a[n_] := If[Mod[2+s[n], 3]==0, q = Quotient[2+s[n], 3]; b[n, q-2, q]/2, 0];
Array[a, 40] (* Jean-François Alcover, Apr 09 2020, after Alois P. Heinz *)
-
EqSumThreeParts(v)={ my(n=#v, vs=vector(n), m=vecsum(v)/3, brk=0);
for(i=1, n-1, vs[i+1]=vs[i]+v[i]; if(vs[i]<=min(1000,m), brk=i));
my(q=Vecrev(prod(i=1, brk, 1+x^v[i]+y^v[i])));
my(recurse(k,s,p)=if(k==brk, if(s<#q, polcoef(p*q[s+1],m,y)), if(s<=vs[k], self()(k-1, s, p*(1 + y^v[k]))) + if(s>=v[k], self()(k-1, s-v[k], p)) ));
if(frac(m), 0, recurse(n-1, m, 1 + O(y*y^m))/2);
}
a(n)={EqSumThreeParts(primes(n))} \\ Andrew Howroyd, Sep 19 2019
A327450
Number of ways the first n squares can be partitioned into three sets with equal sums.
Original entry on oeis.org
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 137, 211, 0, 0, 0, 3035, 0, 0, 0, 120465, 259383, 0, 0, 0, 12328889, 0, 0, 0, 673380980, 1659966694, 0, 0, 0, 69819104134, 0, 0, 0, 3761284888715, 9660240745536, 0, 0, 0, 537238185892321, 0, 0, 0, 29922345673502904
Offset: 1
The unique smallest solution (for n = 13) is 1 + 9 + 25 + 36 + 81 + 121 = 16 + 49 + 64 + 144 = 4 + 100 + 169.
- Keith F. Lynch, Posting to Math Fun Mailing List, Sep 19 2019.
-
s:= proc(n) option remember; `if`(n<2, 0, n^2+s(n-1)) end:
b:= proc(n, x, y) option remember; `if`(n=1, 1, (p-> (l->
add(`if`(p>l[i], 0, b(n-1, sort(subsop(i=l[i]-p, l))
[1..2][])), i=1..3))([x, y, s(n)-x-y]))(n^2))
end:
a:= n-> `if`(irem(1+s(n), 3, 'q')=0, b(n, q-1, q)/2, 0):
seq(a(n), n=1..27); # Alois P. Heinz, Sep 29 2019
-
s[n_] := s[n] = If[n < 2, 0, n^2 + s[n - 1]];
b[n_, x_, y_] := b[n, x, y] = Module[{p, l}, If[n == 1, 1, p = n^2; l = {x, y, s[n] - x - y}; Sum[If[p > l[[i]], 0, b[n - 1, Sequence @@ Sort[ ReplacePart[l, i -> l[[i]] - p]][[1 ;; 2]]]], {i, 1, 3}]]];
a[n_] := Module[{q, r}, {q, r} = QuotientRemainder[1 + s[n], 3]; If[r == 0, b[n, q - 1, q]/2, 0]];
Array[a, 30] (* Jean-François Alcover, Dec 04 2020, after Alois P. Heinz *)
A327448
Number of ways the first n cubes can be partitioned into three sets with equal sums.
Original entry on oeis.org
1, 0, 0, 691, 3416, 0, 233, 1168, 0, 8857, 18157, 0, 2176512, 3628118, 0, 3204865, 8031495, 0, 79514209, 205927212, 0, 5152732369, 13493840291, 0
Offset: 23
The unique smallest solution (for n = 23) is
27 + 216 + 1000 + 2197 + 5832 + 6859 + 9261 =
1 + 64 + 343 + 512 + 1728 + 4096 + 8000 + 10648 =
8 + 125 + 729 + 1331 + 2744 + 3375 + 4913 + 12167.
- Keith F. Lynch, Posting to Math Fun Mailing List, Sep 17 2019.
-
s:= proc(n) option remember; `if`(n<2, 0, n^3+s(n-1)) end:
b:= proc(n, x, y) option remember; `if`(n=1, 1, (p-> (l->
add(`if`(p>l[i], 0, b(n-1, sort(subsop(i=l[i]-p, l))
[1..2][])), i=1..3))([x, y, s(n)-x-y]))(n^3))
end:
a:= n-> `if`(irem(1+s(n), 3, 'q')=0, b(n, q-1, q)/2, 0):
seq(a(n), n=23..27); # Alois P. Heinz, Sep 30 2019
-
s[n_] := s[n] = If[n < 2, 0, n^3 + s[n - 1]];
b[n_, x_, y_] := b[n, x, y] = If[n == 1, 1, With[{p = n^3}, Sum[If[p > #[[i]], 0, b[n - 1, Sequence @@ Sort[ReplacePart[#, i -> #[[i]] - p]][[1 ;; 2]]]], {i, 1, 3}]]&[{x, y, s[n] - x - y}]];
a[n_] := a[n] = If[q = Quotient[1 + s[n], 3]; Mod[1 + s[n], 3] == 0, b[n, q - 1, q]/2, 0];
Table[Print[n, " ", a[n]]; a[n], {n, 23, 34}] (* Jean-François Alcover, Nov 08 2020, after Alois P. Heinz *)
a(32), a(33), a(35) recomputed and a(36)-a(38) added by
Alois P. Heinz, Sep 30 2019
A113035
Number of ways the set {1,2,...,n} can be split into two subsets of which the sum of one is twice the sum of the other.
Original entry on oeis.org
0, 1, 1, 0, 3, 4, 0, 10, 17, 0, 46, 78, 0, 231, 401, 0, 1233, 2177, 0, 6869, 12268, 0, 39502, 71172, 0, 232686, 422076, 0, 1396669, 2547246, 0, 8512170, 15593760, 0, 52534875, 96598865, 0, 327669853, 604405633, 0, 2062171364, 3814087419, 0, 13078921499
Offset: 1
For n=5 we have 5/1234, 14/532 and 23/541 so a(5)=3.
-
A113035:= proc(n) local i,j,p,t; t:= NULL; for j to n do p:=1; for i to j do p:=p*(x^(-2*i)+x^(i)); od; t:=t,coeff(p,x,0); od; t; end;
# second Maple program:
b:= proc(n, i) option remember; local m; m:= i*(i+1)/2;
`if`(n>m, 0, `if`(n=m, 1, b(abs(n-i), i-1) +b(n+i, i-1)))
end:
a:= n-> `if`(irem(n, 3)=1, 0, b(n*(n+1)/6, n)):
seq(a(n), n=1..60); # Alois P. Heinz, Oct 31 2011
-
b[n_, i_] := b[n, i] = Module[{m = i(i+1)/2}, If[n > m, 0, If[n == m, 1, b[Abs[n - i], i - 1] + b[n + i, i - 1]]]];
a[n_] := If[Mod[n, 3] == 1, 0, b[n(n+1)/6, n]];
Array[a, 60] (* Jean-François Alcover, Nov 18 2020, after Alois P. Heinz *)
A113038
Number of ways the set {1,2,...,n} can be split into three subsets of which the sum of one is one more than the equal sums of both other subsets.
Original entry on oeis.org
0, 0, 0, 1, 0, 0, 5, 0, 0, 60, 0, 0, 747, 0, 0, 11076, 0, 0, 183092, 0, 0, 3238140, 0, 0, 60475317, 0, 0, 1175471401, 0, 0, 23600724220, 0, 0, 486653058995, 0, 0, 10260353188386, 0, 0, 220439819437387, 0, 0, 4813287355239594, 0, 0, 106583271423691692, 0, 0
Offset: 1
For n=7 we have splittings 36/27/145, 36/127/45, 136/27/45, 135/27/46, 126/45/37 so a(7) = 5.
-
A113038:=proc(n) local i,j,p,t; t:= 0; for j from 2 to n do p:=1; for i to j do p:=p*(x^(-2*i)+x^i*(y^i+y^(-i))); od; t:=t,coeff(coeff(p,x,1),y,1)/2; od; t; end;
# second Maple program:
b:= proc() option remember; local i, j, t; `if`(args[1]=0, `if`(nargs=2, 1, b(args[t] $t=2..nargs)), add(`if`(args[j] -args[nargs] <0, 0, b(sort([seq(args[i] -`if`(i=j, args[nargs], 0), i=1..nargs-1)])[], args[nargs]-1)), j=1..nargs-1)) end: a:= proc(n) local m; m:= n*(n+1)/2; `if`(m>3 and irem(m, 3)=1, b(((m-1)/3)$2, (m-1)/3+1, n)/2, 0) end: seq(a(n), n=1..50); # Alois P. Heinz, Sep 03 2009
-
A113038[n_] := Module[{i, j, p, t}, t = {0}; For[j = 2, j <= n, j++, p = 1; For[i = 1, i <= j, i++, p = p*(x^(-2*i) + x^i*(y^i + y^(-i))) // Expand]; t = Append[t, Coefficient[Coefficient[p, x, 1], y, 1]/2]; Print[j, " ", t[[-1]]]]; t];
A113038[50] (* Jean-François Alcover, Jan 23 2024, after first Maple program *)
A113039
Number of ways the set {1,2,...,n} can be split into three subsets of which the three sums are consecutive.
Original entry on oeis.org
0, 0, 1, 0, 3, 5, 0, 23, 52, 0, 254, 593, 0, 3611, 8859, 0, 55554, 142169, 0, 946871, 2466282, 0, 17095813, 45359632, 0, 323760077, 870624976, 0, 6367406592, 17307580710, 0, 129063054631, 353941332518, 0, 2682355470491, 7410591325928, 0, 56930627178287
Offset: 1
For n=5 we have splittings 4/23/15, 4/5/123, 13/5/24, so a(5)=3.
-
A113039:=proc(n) local i,j,p,t; t:= 0,0; for j from 3 to n do p:=1; for i to j do p:=p*(x^(-2*i)+x^(i)*(y^i+y^(-i))); od; t:=t,coeff(coeff(p,x,3),y,1); od; t; end;
# second Maple program:
b:= proc() option remember; local i, j, t; `if` (args[1]=0, `if` (nargs=2, 1, b(args[t] $t=2..nargs)), add (`if` (args[j] -args[nargs] <0, 0, b(sort ([seq (args[i] -`if` (i=j, args[nargs], 0), i=1..nargs-1)])[], args[nargs]-1)), j=1..nargs-1)) end: a:= proc(n) local m; m:= n*(n+1)/2; `if` (n>2 and irem (m,3)=0, b(m/3-1, m/3, m/3+1, n), 0) end: seq (a(n), n=1..42); # Alois P. Heinz, Sep 03 2009
-
a[n_] := If[n <= 2, 0, Product[x^(-2k)+x^k(y^k+y^(-k)), {k, 1, n}] // SeriesCoefficient[#, {x, 0, 3}, {y, 0, 1}]&];
Table[an = a[n]; Print[n, " ", an]; an, {n, 1, 26}] (* Jean-François Alcover, Nov 17 2022 *)
A317577
Number of ways the set {1,2,...,n} can be split into three subsets X, Y, Z of equal sums, where the order of X, Y, Z matters.
Original entry on oeis.org
0, 0, 0, 0, 6, 6, 0, 18, 54, 0, 258, 612, 0, 3570, 8880, 0, 55764, 142368, 0, 947946, 2468844, 0, 17099808, 45375498, 0, 323927184, 871038570, 0, 6369199908, 17312303760
Offset: 1
For n = 1, 2, 3, 4, a(n) = 0, as n*(n+1)/2 is not divisible by 3.
For n = 5, a(5) = 6, as {1,2,3,4,5} = {1,4}U{2,3}U{5} and there are 6 permutations.
For n = 6, a(6) = 6, as {1,2,3,4,5,6} = {1,6}U{2,5}U{3,4} and there are 6 permutations.
Showing 1-8 of 8 results.
Comments