login
Number of ways to break {1,2,3,...n} into sets with equal sums.
66

%I #34 Feb 16 2024 11:34:17

%S 1,1,2,2,2,2,6,12,11,2,80,166,2,665,2918,3309,9296,23730,31875,301030,

%T 422897,2,13716867,71504980,100664385,54148591,880696662,498017759,

%U 27450476787,111911522819,179459955554,2144502175214,59115423983,45837019664552,375743493787258,816118711787493,2,9492169507922

%N Number of ways to break {1,2,3,...n} into sets with equal sums.

%C a(n) = 2 <=> |{d|n*(n+1)/2 : d>=n}| = 2. - _Alois P. Heinz_, Sep 03 2009

%H Gus Wiseman, <a href="/A038041/a038041.txt">Sequences counting and ranking multiset partitions whose part lengths, sums, or averages are constant or strict.</a>

%e a(7) = 6 since we have 1234567, 16/25/34/7, 167/2345, 257/1346, 347/1256, 356/1247.

%e From _Gus Wiseman_, Jul 13 2019: (Start)

%e The a(6) = 2 through a(9) = 11 set partitions with equal block-sums:

%e {123456} {1234567} {12345678} {123456789}

%e {16}{25}{34} {1247}{356} {12348}{567} {12345}{69}{78}

%e {1256}{347} {12357}{468} {1239}{456}{78}

%e {1346}{257} {12456}{378} {1248}{357}{69}

%e {167}{2345} {1278}{3456} {1257}{348}{69}

%e {16}{25}{34}{7} {1368}{2457} {1347}{258}{69}

%e {1458}{2367} {1356}{249}{78}

%e {1467}{2358} {159}{2346}{78}

%e {1236}{48}{57} {159}{267}{348}

%e {138}{246}{57} {168}{249}{357}

%e {156}{237}{48} {18}{27}{36}{45}{9}

%e {18}{27}{36}{45}

%e (End)

%p with(numtheory): 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 i, m, x; m:= n*(n+1)/2; 1+ add(b(i$(m/i), n)/(m/i)!, i=[select(x-> x>=n, divisors(m) minus {m})[]]) end: seq(a(n), n=1..25); # _Alois P. Heinz_, Sep 03 2009

%t b[args_List] := b[args] = If[args[[1]] == 0, If[Length[args] == 2, 1, b[Rest[args]]], Sum[If[args[[j]] - args[[-1]] < 0, 0, b[Sort[Join[Table[ args[[i]] - If[i == j, args[[-1]], 0], {i, 1, Length[args]-1}]]], {args[[-1]]-1}]], {j, 1, Length[args]-1}]]; b[a1_List, a2_List] := b[Join[a1, a2]];

%t a[n_] := a[n] = With[{m = n*(n+1)/2}, 1+Sum[b[Append[Array[i&, m/i], n]] / (m/i)!, {i, Select[Divisors[m] ~Complement~ {m}, # >= n &]}]];

%t Table[Print["a(", n, ") = ", a[n]]; a[n], {n, 1, 25}] (* _Jean-François Alcover_, Mar 22 2017, after _Alois P. Heinz_ *)

%t sps[{}]:={{}};sps[set:{i_,___}]:=Join@@Function[s,Prepend[#,s]&/@sps[Complement[set,s]]]/@Cases[Subsets[set],{i,___}];

%t Table[Length[Select[sps[Range[n]],SameQ@@Total/@#&]],{n,0,10}] (* _Gus Wiseman_, Jul 13 2019 *)

%Y Cf. A164977, A164978. - _Alois P. Heinz_, Sep 03 2009

%Y Row sums of A275714.

%Y Cf. A000110, A007837, A038041, A112956, A275780, A275781, A321455, A326512, A326513, A326518, A326534.

%K nonn

%O 1,3

%A _Erich Friedman_

%E More terms from _John W. Layman_, Mar 18 2002

%E a(19)-a(33) from _Alois P. Heinz_, Sep 03 2009

%E a(34) from _Alois P. Heinz_, May 24 2015

%E a(35)-a(38) from _Max Alekseyev_, Feb 15 2024