A240070 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.

3, 5, 13, 23, 35, 30, 45, 53, 71, 71

Offset: 0

Author

T. D. Noe, Apr 02 2014

Keywords

• nonn
• hard
• more

Examples

			For n = 0, the 3 numbers are partitioned as {1}, {2}, {3}.
For n = 1, the 5 numbers are partitioned as {1,4}, {2,3}, {5}.
For n = 2, the 13 numbers are partitioned as {2,10,13}, {4,7,8,12}, {1,3,5,6,9,11}.
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}.
From _Alois P. Heinz_, Apr 04 2014: (Start)
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}.
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)
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}.
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}.
From _Michael S. Branicky_, Jul 02 2020: (Start)
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}.
One partition for n=9 is
  {2,4,5,6,10,12,13,19,20,35,37,44,50,61,63,70,71},
  {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)
		

Crossrefs

Cf. A019568 (partitioned into 2 sets).

Programs

Mathematica

goodQ[set_, n_] :=
Module[{found = False},
  Do[If[Union[set[[i]], set[[j]], set[[k]]] == Range[n] &&
     Length[set[[i]]] + Length[set[[j]]] + Length[set[[k]]] == n,
    Print[{set[[i]], set[[j]], set[[k]]}]; found = True; Break[]], {i,
     Length[set]}, {j, i, Length[set]}, {k, j, Length[set]}]; found];
Join[{3}, Table[k = 1; found = False;
While[s = Range[k]^n; sm = Total[s]/3;
  If[IntegerQ[sm],
   t3 = Select[Subsets[s], Total[#] == sm &]^(1/n);
   found = goodQ[t3, k]]; ! found, k++]; k, {n, 3}]]

Extensions

a(4)-a(5) from Alois P. Heinz, Apr 03 2014

a(6)-a(7) from Dean D. Ballard, Jun 09 2020

a(8)-a(9) from Michael S. Branicky, Jul 02 2020