4
$\begingroup$

Let l be a list

l = Flatten[Range[7] & /@ Range[12]]; (* 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.

$\endgroup$
  • 1
    $\begingroup$ I guess you want "three random permutations" $\endgroup$ – Dr. belisarius Nov 3 '14 at 20:36
  • 1
    $\begingroup$ You might want to look at how to generate random derangements and go from there. $\endgroup$ – Szabolcs Nov 3 '14 at 20:41
  • $\begingroup$ If you want something inefficient: p := Array[RandomSample[l] &, 3];p //. h : {{__} ..} /; Times @@ (Tr /@ Abs /@ Differences /@ Transpose@h) == 0 :> p $\endgroup$ – Dr. belisarius Nov 3 '14 at 20:44
1
$\begingroup$
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[[1]] = RandomSample[l];
For[i = 2, i <= Length[p], i++,
   p[[i]] = p[[1]];
   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.

$\endgroup$
0
$\begingroup$

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 &
    ] &
]
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.