5
$\begingroup$

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

enter image description here

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

enter image description here

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?

$\endgroup$

2 Answers 2

6
$\begingroup$

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

enter image description here

$\endgroup$
0
5
$\begingroup$

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] &

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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