Generate non-overlapping permutations

Let l be a list

l = Flatten[Range & /@ Range]; (* 1,2,3,4,5,6,7,1,2,3,4,5,6,7,... *)

The question is to efficiently generate three random permutations from this list, like

p1 = RandomSample[l];
p2 = RandomSample[l];
p3 = RandomSample[l];

but with a very special property. The three lists may not have an equal value on the same position. In other words: every element of Transpose[{p1,p2,p3}] must have three unique values.

• I guess you want "three random permutations" – Dr. belisarius Nov 3 '14 at 20:36
• You might want to look at how to generate random derangements and go from there. – Szabolcs Nov 3 '14 at 20:41
• If you want something inefficient: p := Array[RandomSample[l] &, 3];p //. h : {{__} ..} /; Times @@ (Tr /@ Abs /@ Differences /@ Transpose@h) == 0 :> p – Dr. belisarius Nov 3 '14 at 20:44

p = Table[, {3}]; (* 3 is the number of 'special' permutations. Note that this number cannot be greater than the number of unique elements of l *)
p[] = RandomSample[l];
For[i = 2, i <= Length[p], i++,
p[[i]] = p[];
Do[
p[[i, j]] = RandomChoice[Complement[l, Table[p[[k, j]], {k, i - 1}]]],
{j, Length[l]}]
]

This seems to be a method without trial and error. One could speed it up by storing the result of the complement for each i as it only changes a little for each next i.

Not sure this is any useful, but this generates the 3 permutations and then check if the condition is met. Otherwise it starts again.

NestWhile[
Table[RandomSample[l], {3}] &,
Table[RandomSample[l], {3}],
!VectorQ[
#,
Length[DeleteDuplicates[#]] === 3 &
] &
]