Creating a random matrix of no duplicates in both row and column from a given set list of elements

Question

Say I have a list of letters {A,B,C,D,E,F,G,H}, I want to create an $4\times 8$ array where each row must not contain duplicates and each column must also not contain duplicates.

Naively writing:

gps = CharacterRange["A", "H"];
Table[RandomSample[gps], {4}] // MatrixForm

gives you the correct condition that no row may contain duplicates. Take an example below:

$ \left( \begin{array}{cccccccc} \text{H} & \text{G} & \text{C} & \text{E} & \text{F} & \text{B} & \text{A} & \text{D} \\ \text{G} & \text{D} & \text{H} & \text{A} & \text{F} & \text{C} & \text{B} & \text{E} \\ \text{B} & \text{E} & \text{C} & \text{G} & \text{H} & \text{A} & \text{F} & \text{D} \\ \text{A} & \text{C} & \text{D} & \text{F} & \text{H} & \text{B} & \text{G} & \text{E} \\ \end{array} \right) $

Every row is unique, but column 3,5,6,8 all have duplicates. This is the case most of the time that one column or more will have a duplicate. Brute force I would just create a while loop that keeps doing random sampling until the more difficult no duplicate in column conditions is met.

This way doesn't really sit well with me. Perhaps there is a fancy use of permutations. Any ideas would be great. Thanks

Answer 1

With the conditions that each row must not contain duplicates and each column must not contain duplicates, construct a random solution matrix by rows. The first row is a random sample of the permutations of gps. The following rows are selected at random from the remaining permutations that satisfy the conditions.

There are two questions to consider from comments: 1) does the first row determine the rest of the matrix, and 2) is the resulting matrix truly random or does it contain structure and pattern.

Question 1: The first row determines the rest of the solution matrix because each row after the first must be a member of a subset of the permutations of gps, such that no column can match the corresponding column of the previous rows.

To demonstrate the method, consider the set {A,B,C,D,E}. Here's a graph that shows how selecting rows at random proceeds from row 1 to row 4.

Starting with {A,B,C,D,E}, there are 44 possibilities for row 2. Selecting {D,A,B,E,C} leaves 13 possibilities for row 3. Selecting {E,C,D,A,B} leaves 4 possibilities for row 4. Choosing {C,E,A,B,D} completes the solution matrix.

{A,B,C,D,E}
{D,A,B,E,C}
{E,C,D,A,B}
{C,E,A,B,D}

Question 2: The solution matrix cannot be truly random because of the conditions that no row or column contain matches. Rows 2,3,4 are generated from row 1, but row 1 is random. There must be structure and pattern for the following rows because of the condition that there are no matching columns. However, rows 2,3,4 are randomly selected from every possible row that satisfies the conditions given the previous rows. The solution matrix is as random as it can be while satisfying the conditions.

Here's a revised method that replaces my original attempt.

perms = StringJoin[#] & /@ Permutations[gps];
rows = {StringJoin[RandomSample[gps]]};
Do[
 regex = StringRiffle[Characters[Last@rows], {"^[^", "][^", "]$"}];
 perms = Flatten@
   DeleteCases[StringCases[perms, RegularExpression[regex]], {}];
 AppendTo[rows, RandomChoice[perms]];
 , 3]
(matrix = Characters[rows]) // MatrixForm

The permutations, perms, rows are saved as strings. Use a regular expression to remove permutations that match any column of the current row. Select a new row from the remaining permutations.

Answer 2

ClearAll[derangementF,  dupeFreeArray]
derangementF = With[{x = Range @ Length @ #, a = #},  a[[#]] & /@ 
 Pick[Permutations[x], Unitize[Times @@@ Function[t, Subtract[#, t]] /@ {##} & @@ 
   Permutations[x]], 1]] &;
dupeFreeArray = Module[{a = {RandomSample @ #}, derangements}, 
 derangements = derangementF[Last @ a];
 Do[AppendTo[a, RandomChoice[derangements = 
   Intersection[derangements, derangementF[Last @ a]]]], {#2 - 1}]; a] &;

Examples:

dfa = dupeFreeArray[CharacterRange["A", "I"], 5]
TeXForm @ MatrixForm @ dfa

$\left( \begin{array}{ccccccccc} \text{G} & \text{A} & \text{D} & \text{H} & \text{E} & \text{C} & \text{B} & \text{F} & \text{I} \\ \text{D} & \text{B} & \text{G} & \text{A} & \text{I} & \text{F} & \text{C} & \text{E} & \text{H} \\ \text{A} & \text{I} & \text{F} & \text{B} & \text{D} & \text{H} & \text{E} & \text{C} & \text{G} \\ \text{B} & \text{D} & \text{H} & \text{F} & \text{C} & \text{I} & \text{A} & \text{G} & \text{E} \\ \text{E} & \text{G} & \text{C} & \text{I} & \text{H} & \text{B} & \text{D} & \text{A} & \text{F} \\ \end{array} \right)$

And @@ (DuplicateFreeQ /@ Transpose[dfa])

True

dfa2 = dupeFreeArray[CharacterRange["A", "I"], 9]
TeXForm @ MatrixForm @ dfa2

$\left( \begin{array}{ccccccccc} \text{I} & \text{D} & \text{G} & \text{B} & \text{F} & \text{A} & \text{H} & \text{C} & \text{E} \\ \text{E} & \text{H} & \text{C} & \text{G} & \text{I} & \text{D} & \text{F} & \text{A} & \text{B} \\ \text{D} & \text{A} & \text{I} & \text{C} & \text{G} & \text{B} & \text{E} & \text{F} & \text{H} \\ \text{C} & \text{B} & \text{F} & \text{H} & \text{E} & \text{G} & \text{A} & \text{D} & \text{I} \\ \text{A} & \text{F} & \text{H} & \text{I} & \text{D} & \text{E} & \text{G} & \text{B} & \text{C} \\ \text{H} & \text{I} & \text{E} & \text{A} & \text{C} & \text{F} & \text{B} & \text{G} & \text{D} \\ \text{G} & \text{E} & \text{B} & \text{D} & \text{A} & \text{I} & \text{C} & \text{H} & \text{F} \\ \text{B} & \text{G} & \text{D} & \text{F} & \text{H} & \text{C} & \text{I} & \text{E} & \text{A} \\ \text{F} & \text{C} & \text{A} & \text{E} & \text{B} & \text{H} & \text{D} & \text{I} & \text{G} \\ \end{array} \right)$

And @@ (DuplicateFreeQ /@ Transpose[dfa2])

True

Answer 3

You are generating Latin rectangles. Here are three links that might be of interest:

1. Generate Random Latin squares
2. Latin rectangles from Wolfram MathWorld
3. Latin Square from Wolfram MathWorld

Here is a brute force approach that allows for a mixing of numeric and character values:

latinRectangle[x0_, rows_] := Module[{n, x},
  n = Length[x0];
  x = ConstantArray[x0, rows];

  (* First row *)
  x[[1]] = RandomSample[x0, n];

  (* Subsequent rows *)
  Do[
   x[[i]] = RandomSample[x0, n];
   While[Length[Select[Flatten[Table[MapThread[Equal, {x[[i]], x[[j]]}], {j, 1, i - 1}]], 
     # == True &]] > 0, x[[i]] = RandomSample[x0, n]], {i, 2, rows}];

  x]

SeedRandom[12345]

latinRectangle[{"1", "A", "C", 4, 5}, 4] // MatrixForm

$$\left( \begin{array}{ccccc} 1 & 4 & \text{C} & 5 & \text{A} \\ \text{C} & 1 & 5 & \text{A} & 4 \\ 4 & \text{C} & \text{A} & 1 & 5 \\ \text{A} & 5 & 1 & 4 & \text{C} \\ \end{array} \right)$$

latinRectangle[Range[8], 8] // MatrixForm

$$\left( \begin{array}{cccccccc} 8 & 2 & 7 & 3 & 1 & 5 & 4 & 6 \\ 5 & 8 & 2 & 1 & 6 & 3 & 7 & 4 \\ 3 & 6 & 4 & 5 & 2 & 7 & 1 & 8 \\ 1 & 5 & 8 & 6 & 3 & 4 & 2 & 7 \\ 7 & 3 & 1 & 8 & 4 & 2 & 6 & 5 \\ 2 & 1 & 5 & 4 & 7 & 6 & 8 & 3 \\ 4 & 7 & 6 & 2 & 5 & 8 & 3 & 1 \\ 6 & 4 & 3 & 7 & 8 & 1 & 5 & 2 \\ \end{array} \right)$$

Here, too, this is not for large lists (like maybe not much bigger than 10).