Shuffling a list with a constraint

Question

Preparing a new psychophysical experiment, I have 48 original stimuli displayed 4 times (4 conditions), resulting in 192 trials. Trying to randomize the order of presentation during the experiment, I need to maximize the distance between the 4 display of the same original stimuli.

Please consider :

Table[{j, i}, {j, Range[48]}, {i, Range[4]}]

Where j is the original stimuli number and i the condition

Output Sample :

 {{1, 1}, {1, 2}, {1, 3}, {1, 4}, 
  {2, 1}, {2, 2}, {2, 3}, {2, 4},   
  ...
  {47, 1}, {47, 2}, {47, 3},{47, 4}, 
  {48, 1}, {48, 2}, {48, 3}, {48, 4}}

How could I shuffle the order of presentation of those 192 items, maximizing the distance between identical items with regard to j, the original stimuli number?

Answer 1

You have to have a compromise between randomness and your constraint of maximum distance between original stimuli. A maximum distance is obtained when you arrange the stimuli in 4 identical series of 48 stimuli (a non-random presentation). The distance is fixed at 48 for every original stimulus in that case.

If you distribute the 192 pairs totally random the average distance between the original stimuli is 38.6 on average, with minimum and maximum possible distances of 1 and 144 respectively:

t = Flatten[Table[i, {4}, {i, 48}]]; 

{Mean[#], StandardDeviation[#]} &@  
Table[
  rs = RandomSample[t, 192];
    Mean[Mean[Differences[Flatten[Position[rs, #]]]] & /@ Range[48]] // 
   N, {10000}
]

(* ==> {38.60370417, 1.397151004} *)

You can do it differently. First split the 48 stimuli in 2 blocks of 24 (1-24 [block I] and 25-48 [block II]). Then generate random permutations (p) of I and II: p(I)p(II)p(I)p(II)p(I)p(II)p(I)p(II).

The average distance now becomes:

{Mean[#], StandardDeviation[#]} &@  
Table[
  rs = 
    Join[RandomSample[Range[24]], RandomSample[Range[25, 48]], 
         RandomSample[Range[24]], RandomSample[Range[25, 48]],
         RandomSample[Range[24]], RandomSample[Range[25, 48]], 
         RandomSample[Range[24]], RandomSample[Range[25, 48]]
    ];
  Mean[Mean[Differences[Flatten[Position[rs, #]]]] & /@ Range[48]] //N, {10000}]

(* ==> {48., 0.} *)

So we now have a much more random presentation while the average distance is still 48 (minimum distance now is 24 and maximum distance is 47). Note the standard deviation of 0. As an exercise I'll leave the proof of why that must be so to you.

---

Update 1
I've arranged the stimuli in two groups here, 1-24 and 25-48. I suggest you use a new random initial arrangement for each subject, before you start breaking up into two groups. This will introduce a bit of extra balancing over subjects.

---

Update 2
And now, the code for the stimulus-condition combo generation:

First, randomize condition over all stimuli:

m = MapThread[
       List, 
       {
         Table[Range[48], {4}], 
         Table[RandomSample[{1, 2, 3, 4}], {48}]\[Transpose]
       }, 2
    ]

Then, break up in groups of 24, shuffle those, and arrange as one list:

Flatten[RandomSample /@ Partition[Flatten[m, 1], 24], 1]

To randomize the order for each subject (as I suggested above in update 1) a small change is necessary in the first part:

initialArrangement = RandomSample[Range[48]]; 
m = 
 MapThread[
    List, 
    {
       Table[initialArrangement, {4}], 
       Table[RandomSample[{1, 2, 3, 4}], {48}]\[Transpose]
    }, 2
 ]

Please note that it would be really wrong to put the first line (RandomSample[Range[48]]) inside the Table!

---

For Mr.Wizard here the infix notation version to show I'm really trying ;-)

m~Set~MapThread[List, (Range[48]~Table~{4}~
    List~((RandomSample[{1, 2, 3, 4}]~Table~ {48})\[Transpose])), 2]

and the second part:

(RandomSample /@ m~Flatten~1~Partition~24)~Flatten~1

The variation of the first part, like above:

initialArrangement~Set~RandomSample[Range[48]]; 
m~Set~MapThread[List, (initialArrangement~Table~{4}~
    List~((RandomSample[{1, 2, 3, 4}]~Table~ {48})\[Transpose])), 2]

BTW Forget the parenthesis in the second part and the output, though looking similar, will be completely wrong.

Answer 2

Perhaps:

a = RandomSample@Range@48;
Flatten[Array[Partition[Riffle[a, #1], 2] &, 4], 1]

Answer 3

Following Belisarius' way I would rather write like this :

RandomSample[Flatten[Table[{j, i}, {j, Range[48]}, {i, Range[4]}], 1]]