Skip to main content
4 of 8
clarify
Mark Adler
  • 5k
  • 1
  • 22
  • 38

There are a bunch of Region functions that just showed up in 10. This uses RegionDistance[] to make a function that computes the shortest distance from a point to a region. The generated function runs faster than just checking all the circles. Though the creation of the function in the first place has to look at all the circles. So this still runs in $\mathrm O(n^2)$ time, but at least the inner While should be faster when there are already a lot of circles and not a lot of places to put a new one.

distinct[n_,r_]:=Module[{d,f,p},
  d={Circle[RandomReal[{-1,1},2],r]};
  Do[
    f=RegionDistance[RegionUnion@@d];
    While[p=RandomReal[{-1,1},2];f[p]<r];
    d=Append[d,Circle[p,r]],
    {n-1}];
  d
]

Example:

distinct[75, 0.1] // Graphics

75 non-overlapping circles

The following runs quite a bit faster, generating a Nearest function for a large set of circles, and using that one function to eliminate many overlaps in a single pass.

sweep[pts_,r_]:=Module[{p,f,c},
  p=pts;
  While[
    f=Nearest[p->Automatic];
    c=f[p,{2,r}];
    Last[Dimensions[c]]!=1,
    p=Pick[p,First[#]<=Last[#]&/@c];
  ];
  p
]

distinct2[n_,r_]:=Module[{p},
  p={};
  While[
    p=Join[p,RandomReal[{-1,1},{n,2}]];
    p=sweep[p,2r];
    Length[p]<n
  ];
  Circle[#,r]&/@Take[p,n]
]

Measuring the performance (your mileage may vary):

Timing[distinct[75,0.1];]
{3.021209,Null}
Timing[distinct2[75,0.1];]
{0.077105,Null}

A problem with both of these algorithms is that there is no assurance that they will halt. You can ask for too many circles, and end up with the While loops trying to add circles forever when there is no place to put even one. If this is supposed to be part of some larger automated process, then you need to add a check for no progress after so many tries in order to give up.

Mark Adler
  • 5k
  • 1
  • 22
  • 38