We may assume that the partition we are looking for is ordered, and that every triple is ordered as well. When we flatten this list of partitions, we arrive at a permutation of the first nn integers, such that the first value is 1, the values at the positions 1,4,7, ... are increasing, and for every n the values at the positions 3n+1, 3n+2 and 3n+3 are increasing and the value at position 3n+3 is the sum of the values at the positions 3n+1 and 3n+2. Moreover, each value at the positions 1,4,7,... must be less than nn/2. Our backtracking process tries to construct this list, in the implementation called result. At any stage we have a number k, the position at which we have to place a number in the list result, and moreover a list called available of the numbers from which we can choose. We start with the list result with the first number 1 placed, the list available with the complete range and k=1. The construction is then as follows:
- when we are at a position with mod(k,3)=1, we place the smallest available numberless than nn/2 and larger than the last placed number at that position. If that is impossible, we go back to position 2 at the previous triple.
- when we are at a position with mod(k,3)=2, we complete the triple with the smallest available second value. If that is impossible, we go back to position 1 of the same triple.
Here is the implementation.
ggg=Compile[{{nn,_Integer, 0}},
Module[{result, available, k, a,b,c,n},
result=Table[0,{nn}];
result[[1]]=1;
available=Range[nn];
available[[1]]=0;
k=2;
While[2<=k<=nn,
Which[
Mod[k,3]==1&&k<nn,
n=0;Do[If[available[[i]]==i,n=i; Break[]],{i,result[[k]]+1,nn}];
If[1<=n<nn/2, result[[k]]=n; available[[n]]=0; k=k+1,
Do[available[[i]]=i, {i, result[[{k-2,k-1}]]}];
result[[k]]=0;result[[k-1]]=0;k=Max[{k-2, 0}]],
Mod[k,3]==2&&k<nn,
a=result[[k-1]];
b=0;c=0;
n=result[[k]]; If[n==0, n=a];
Do[If[available[[i]]==i, c=a+i; Which[c>nn, Break[],
available[[c]]==c, b=i;Break[]]], {i,n+1,nn}];
If[b>0,
result[[k]]=b; result[[k+1]]=c; k=k+2; available[[b]]=0;available[[c]]=0,
result[[k]]=0; available[[a]]=a;k=k-1]
]];
result], CompilationTarget->"C"];
Partition[ggg[27], 3] // Timing
(* {13.3693,{{1,2,3},{4,14,18},{5,16,21},{6,19,25},{7,20,27},
{8,15,23},{9,17,26},{10,12,22},{11,13,24}}} *)
The argument of the function ggg must be a multiple of 3. When for such a value a partion does not exist, a list containing zeros is returned.
Now we can try a lot of arguments, but we can restrict the domain. Since every third number is the sum of its two predecessors, the sum of all third numbers must be half of the sum of all numbers, so when the sum of all numbers is odd, such a partition does not exist. Therefore, a necessary condition for a partition to exist is that nn(nn+1)/2 is even, that is nn has to a multiple of 4 or nn+1 has to be a multiple of 4.
That can be seen in a different way as well. In every triple there are 0 or 2 odd numbers. Therefore, in the range of nn there must be an even amount of odd numbers, which means that nn has to be a multiple of 4 or nn+1 has to be a multiple of 4.
We only have to consider the values 3, 12, 15, 24, 27, 36, 39, ...
Already for nn=36, the number of situations that have to be considered is so large that a partition can hardly be found in a reasonably time. We can reduce the number of situations with another assumption, that seems to be satisfied: there is a partition with the property that the successive triples start with 1, 2, 3, .... That gives the following function:
hhh=Compile[{{nn,_Integer,0}},Module[{result, available, k,a,b,c,n},result=Table[0,{nn}];
Do[result[[3i-2]]=i,{i,1,nn/3}];
available=Range[nn];
Do[available[[i]]=0, {i,1,nn/3}];
k=2;
While[1<k<nn,
a=result[[k-1]];
b=0;c=0;
n=result[[k]]; If[n==0, n=a];
Do[If[available[[i]]==i, c=a+i; Which[c>nn, Break[], available[[c]]==c, b=i;Break[]]],
{i,n+1,nn}];
If[b>0,
result[[k]]=b; result[[k+1]]=c; k=k+3; available[[b]]=0; available[[c]]=0,
available[[result[[k-3]]]]=result[[k-3]];available[[result[[k-2]]]]=result[[k-2]];
result[[k-2]]=0; result[[k]]=0; k=k-3] ];
result],
CompilationTarget->"C"];
This is considerably faster:
Partition[hhh[27],3]//Timing
(* {0.,{{1,10,11},{2,12,14},{3,15,18},{4,19,23},{5,22,27},{6,20,26},
{7,17,24},{8,13,21},{9,16,25}}} *)
We now can go even as far as 60:
Partition[hhh[60],3]//Timing
(* {42.2451,{{1,21,22},{2,23,25},{3,24,27},{4,26,30},{5,28,33},{6,29,35},
{7,34,41},{8,40,48},{9,42,51},{10,39,49},{11,45,56},{12,46,58},{13,47,60},
{14,43,57},{15,44,59},{16,37,53},{17,38,55},{18,36,54},{19,31,50},20,32,52}}} *)
These results strongly suggest that the condition that nn or nn+1 is a multiple of 4 is also sufficient.
