Generating random numbers that keep a minimum distance
- Construct a random sample from
Range[m]
satisfying the minimum distance requirements taking into account the fact that if $x_k$ is selected at step $k$, the choices in step $k+1$ are restricted to the range from $x_k + d$ to $m - (n-k)d$ to be able to get $n-k$ additional elements in remaining steps satisfying the minimum distance constraint. - Shuffle the list obtained in the first step
ClearAll[f]
f[m_, n_, d_] /; n d <= m := RandomSample @ Rest @
FoldList[RandomChoice[Range[# + Boole[#2 > 1] d, m - (n - #2) d]] &, 1, Range[n]]
Examples:
Table[f[10, 3, 2], {5}]
{{8, 3, 6}, {6, 10, 8}, {8, 5, 10}, {8, 10, 6}, {10, 1, 4}}
Min[Differences@Sort@#] & /@ %
{2, 2, 2, 2, 3}
f[10, 4, 3]
f[10, 4, 3] (* impossible *)
f[1000, 100, 8]
{848, 808, 189, 776, 680, 824, 472, 728, 352, 976, 736, 544, 504, 936, 904, 408, 720, 400, 816, 448, 856, 560, 279, 336, 312, 512, 888, 928, 424, 944, 584, 480, 238, 552, 920, 568, 528, 600, 952, 304, 536, 688, 632, 712, 992, 592, 616, 221, 896, 456, 864, 344, 792, 744, 392, 624, 320, 984, 576, 206, 648, 960, 368, 840, 872, 376, 328, 752, 832, 24, 288, 640, 416, 1000, 760, 696, 520, 488, 672, 464, 249, 800, 968, 768, 664, 432, 384, 784, 271, 912, 296, 656, 704, 496, 608, 230, 880, 360, 257, 440}
Min @ Differences@ Sort @ %
8
res = f[10000000, 10000, 800]; // AbsoluteTiming // First
0.105936
Min @ Differences @ Sort @ res
800
Update: An alternative implementation using NestList
:
ClearAll[f2]
f2[m_, n_, d_] /; n d <= m := Module[{k = 1}, RandomSample @ Rest @
NestList[RandomChoice[Range[# + Boole[k++ > 1] d, m - (n - k) d]] &, 1, n]]
Easiest solution is as follows: for a required minimum distance $d$ such that $|x_i - x_j| \ge d$ for all $1 \le i \ne j \le n$, select $y_1 < \ldots < y_n$ from $\{1, \ldots, m - (n-1)(d-1)\}$ without replacement and construct the sample $$x_i = y_i + (i-1)(d-1).$$ This is only possible if $m - (n-1)(d-1) \ge n$ or equivalently, $m > (n-1)d$.
The above can be implemented as
F[m_, n_, d_] := Sort[RandomSample[Range[m - (n - 1)(d - 1)], n]] + (Range[n] - 1)(d - 1)
and if a random permutation of the sorted sample is desired, simply take RandomSample
of the output. No recursion is needed and no lengthy functions are used.
For example, if $m = 10$, $n = 4$, $d = 2$, there are $\binom{7}{4} = 35$ $4$-tuples from $\{1, \ldots, 10\}$ such that the minimum difference between elements is at least $2$. Then
ParallelTable[F[10, 4, 2], {10^6}] // Tally
simulates $10^6$ such random samples, and tallies the frequency of each outcome.
How about something like this - rather than picking random numbers until one satisfies the minimum distance criteria, pick the random number from a set that excludes disallowed values.
gen2[m_, n_, min_] := Module[{nCells, set},
set = Range[m];
nCells = RandomSample[set, 1];
While[Length[nCells] < n && Length[set] > 0,
set = Complement[set,
Range[nCells[[-1]] - min + 1, nCells[[-1]] + min - 1]];
If[Length[set] < 1, Print["Couldn't pick ", n],
nCells = Join[nCells, RandomSample[set, 1]]];
];
nCells]
Table[gen2[10, 3, 2], {10}] // Column
(*
{4,7,10}
{8,3,6}
{2,6,9}
{5,8,3}
{7,10,1}
{3,10,6}
{3,7,10}
{3,9,6}
{1,10,5}
{9,2,6} *)
As noted by Henrik Schumacher in the comments, n=100, m=1000, min=8 doesn't work most of the time (you get an empty set before you pick 100 numbers):
gen2[1000, 100, 8]
(*
Couldn't pick 100
{599, 14, 526, 475, 52, 448, 791, 576, 196, 711, 941, 35, 211, 483, \
371, 401, 827, 354, 757, 547, 858, 86, 222, 336, 696, 913, 419, 386, \
812, 363, 982, 974, 563, 966, 665, 279, 955, 494, 243, 675, 151, 994, \
742, 5, 298, 438, 901, 316, 24, 627, 636, 873, 411, 684, 261, 516, \
107, 586, 138, 768, 508, 290, 650, 253, 850, 116, 73, 464, 173, 163, \
129, 94, 428, 346, 842, 609, 888, 306, 619, 181, 922, 44, 555, 931, \
231, 539, 327, 731, 776, 456, 799, 64, 722, 271} *)
But 7 is fine:
test = gen2[1000, 100, 7]
(*
{556, 966, 917, 863, 425, 155, 414, 504, 43, 82, 395, 196, 765, 701, \
55, 330, 935, 626, 337, 843, 511, 885, 441, 834, 756, 117, 572, 285, \
519, 17, 189, 658, 563, 817, 266, 727, 28, 854, 805, 747, 775, 210, \
997, 546, 138, 303, 608, 295, 900, 145, 718, 355, 176, 666, 130, 946, \
259, 102, 405, 795, 452, 649, 480, 591, 240, 363, 63, 641, 95, 694, \
493, 221, 536, 978, 633, 784, 739, 387, 871, 827, 675, 465, 10, 954, \
580, 599, 686, 878, 36, 1, 926, 373, 320, 529, 348, 248, 708, 893, \
311, 273} *)
Test the minimum distance between numbers:
stest = Sort[test];
Min[Table[stest[[i]] - stest[[i - 1]], {i, 2, Length[test]}]]
(* 7 *)
```