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
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.