|
MATHEMATICA
|
NextTuple[x_, n_, l_] := Module[{i, x0 = x},
If[x0 == ConstantArray[n, l], Return[{}]];
For[i = l, i >= 1, i--,
If[x0[[i]] < n, x0[[i]]++; Return[x0], x0[[i]] = 1]]];
Join[{1}, Table[p = Permutations[Range[n], {n}];
For[tl = n + 1, tl <= 50, tl++,
tup = ConstantArray[1, tl];
While[tup = NextTuple[tup, n, tl]; tup != {},
If[Product[Count[tup, i], {i, 1, n}] == 0, Continue[]];
For[j = 1, j <= Length[p], j++,
perm = p[[j]]; lst = tup; fnd = True;
For[k = 1, k <= Length[perm], k++,
If[lst == {}, fnd = False; Break[]];
p1 = Position[lst, perm[[k]], 1, 1];
If[Length[p1] == 0, fnd = False; Break[]];
p1 = First@First@p1;
If[! IntegerQ[p1], fnd = False; Break[]];
lst = Drop[lst, p1];
]; If[! fnd, Break[]]]; If[fnd, Break[]]]; If[fnd, Break[]]];
|