# Fill a matrix with randomly placed elements that are a certain distance apart

Problem statement

I want to populate a matrix of points with randomly placed elements, here denoted as x. In all matrix rows there must be an equal number of x-elements with at least d points between them.

Partial solution

Matrix rows and columns

n = 15;


Matrix of points

m = Array["." &, {n, n}];


Minimum points between elements (distance)

d = 2;


Possible positions

p = Range[1, n, d + 1]


{1, 4, 7, 10, 13}

Number of elements per row

e = 3;


x - Positions

xp =
Catenate @ Table[
Map[
Prepend[i] @* List,
RandomSample[p, e] + RandomInteger[{0, 2}]],
{i, 1, n}];


Possible result with d = 2 and e = 3

MapAt[Style["x", Red, Bold] &, xp] @ m // MatrixForm


Possible results with d = 2 and e = 2 / e = 5

Question

Because of the addition of RandomInteger[{0, 2}] my solution only functions with row lengths n which are divisible by 3. How can I implement these random placements

(a) for arbitrary matrix sizes n?

(b) for arbitrary distances d?

If you really want to sample randomly (and uniformly), I believe you should first construct the set of all possible rows (or ensure the uniformness in some other way).

Here is an approach using IntegerPartitions.

randomMatrix[n_, d_, e_] :=
Module[{allPartitions, allowedPartitions, allRows},
(* Construct all partitions of a row into e+1 chunks of . *)
allPartitions = Catenate[Permutations /@
IntegerPartitions[n - e, {e + 1}, Range[0, n]]];

(* Select partitions where length of all inner chunks is at least d *)
allowedPartitions = Cases[allPartitions, {_, x___, _} /; x >= d];

(* Transform partitions into rows of x and . *)
allRows = Table[Flatten@Riffle[ConstantArray[".", #] & /@ part,
Style["x", Red, Bold]], {part, allowedPartitions}];

(* Sample randomly *)
RandomChoice[allRows, n]
]

randomMatrix[10, 2, 3] // MatrixForm


Using a RelationGraph projection:

 matrixRowElementsByDistance[n_, e_, d_] := Module[{graph, paths},
graph = RelationGraph[#2 - #1 >= d + 1 &, Range[n]];
paths = Flatten[Table[FindPath[graph, i, j, {e - 1}, All]
, {i, VertexList[graph]}, {j, VertexList[graph]}], 2] ;
MapAt[Style["x", Red, Bold] & , Array["." &, {n, n}]
, Flatten[
MapIndexed[
Tuples[{#2, #1}] &, Check[RandomChoice[paths, n], {}]],1]]
]

matrixRowElementsByDistance[50, 10, 3] //
MatrixPlot[#, ColorRules -> {"." -> White, _ -> Red}, Mesh -> True] &