%I #37 Aug 29 2020 05:48:58
%S 3,5,13,23,35,30,45,53,71,71
%N a(n) is the least k such that {1^n, 2^n, 3^n, ..., k^n} can be partitioned into 3 sets whose sums are equal.
%e For n = 0, the 3 numbers are partitioned as {1}, {2}, {3}.
%e For n = 1, the 5 numbers are partitioned as {1,4}, {2,3}, {5}.
%e For n = 2, the 13 numbers are partitioned as {2,10,13}, {4,7,8,12}, {1,3,5,6,9,11}.
%e For n = 3, the 23 numbers are partitioned as {3,6,10,13,18,19,21}, {1,4,7,8,12,16,20,22}, {2,5,9,11,14,15,17,23}.
%e From _Alois P. Heinz_, Apr 04 2014: (Start)
%e One partition for n=4 is {1,2,12,17,18,20,21,22,23,24,25,27,28,30}, {3,4,5,6,9,13,14,16,26,31,32,33}, {7,8,10,11,15,19,29,34,35}.
%e One partition for n=5 is {1,2,3,6,13,14,15,17,19,20,22,23,30}, {4,7,8,10,12,16,18,25,27,28}, {5,9,11,21,24,26,29}. (End)
%e One partition for n=6 is {1,3,5,9,11,14,15,19,20,21,27,29,34,35,43,45}, {4,6,7,10,12,13,16,17,24,28,33,36,38,41,44}, {2,8,18,22,23,25,26,30,31,32,37,39,40,42}.
%e One partition for n=7 is {2,4,5,6,8,12,16,20,21,22,25,27,29,30,32,35,36,40,46,50,53}, {1,3,10,13,14,18,24,28,33,34,37,38,39,41,42,45,47,52}, {7,9,11,15,17,19,23,26,31,43,44,48,49,51}.
%e From _Michael S. Branicky_, Jul 02 2020: (Start)
%e One partition for n=8 is {1,2,5,7,11,13,18,24,25,26,27,29,32,34,35,36,41,52,66,67,68,69}, {4,8,9,15,17,20,21,23,30,43,47,50,53,54,55,57,60,61,62,63,70}, {3,6,10,12,14,16,19,22,28,31,33,37,38,39,40,42,44,45,46,48,49,51,56,58,59,64,65,71}.
%e One partition for n=9 is
%e {2,4,5,6,10,12,13,19,20,35,37,44,50,61,63,70,71},
%e {1,7,22,24,26,27,29,31,33,36,38,39,40,41,42,46,47,49,52,54,56,59,66,68,69}, {3,8,9,11,14,15,16,17,18,21,23,25,28,30,32,34,43,45,48,51,53,55,57,58,60,62,64,65,67}. (End)
%t goodQ[set_, n_] :=
%t Module[{found = False},
%t Do[If[Union[set[[i]], set[[j]], set[[k]]] == Range[n] &&
%t Length[set[[i]]] + Length[set[[j]]] + Length[set[[k]]] == n,
%t Print[{set[[i]], set[[j]], set[[k]]}]; found = True; Break[]], {i,
%t Length[set]}, {j, i, Length[set]}, {k, j, Length[set]}]; found];
%t Join[{3}, Table[k = 1; found = False;
%t While[s = Range[k]^n; sm = Total[s]/3;
%t If[IntegerQ[sm],
%t t3 = Select[Subsets[s], Total[#] == sm &]^(1/n);
%t found = goodQ[t3, k]]; ! found, k++]; k, {n, 3}]]
%Y Cf. A019568 (partitioned into 2 sets).
%K nonn,hard,more
%O 0,1
%A _T. D. Noe_, Apr 02 2014
%E a(4)-a(5) from _Alois P. Heinz_, Apr 03 2014
%E a(6)-a(7) from _Dean D. Ballard_, Jun 09 2020
%E a(8)-a(9) from _Michael S. Branicky_, Jul 02 2020
|