Generate nonoverlapping random circles [duplicate]

I want to distribute n circles unformly in an area(e.g. free plannar space). The circles could touch each other but cannot overlap.

n = 5;
r = 0.2;
Table[pt[i] = RandomReal[{-1, 1}, 2], {i, 1, n}];
Graphics[{Table[Circle[pt[i], r], {i, n}]}, Axes -> True,
PlotRange -> {{-1, 1}, {-1, 1}}]

My method is to generate the random points firstly, and then calculate the smallest distance between all point pairs. If the smallest distance is larger than 2r, the points are kept. However, the problem with this method is that the larger the radius, the more trials have to be taken. 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. E.g.:

distinct3[n_,r_,maxiter_]:=Module[{p,m,k},
p={};
m=0;
k=maxiter;
While[
p=Join[p,RandomReal[{-1,1},{n,2}]];
p=sweep[p,2r];
k=If[Length[p]>m,maxiter,k-1];
m=Length[p];
m<n&&k>0
];
Circle[#,r]&/@If[Length[p]>n,Take[p,n],p]
]

Then:

distinct3[100,0.1,1000]//Length
80
distinct3[100,0.1,1000]//Length
78

As pointed out by Ernst Stelzer, this works in 3D just as well with two small changes:

distinct3D[n_,r_,maxiter_]:=Module[{p,m,k},
p={};
m=0;
k=maxiter;
While[
p=Join[p,RandomReal[{-1,1},{n,3}]];
p=sweep[p,2r];
k=If[Length[p]>m,maxiter,k-1];
m=Length[p];
m<n&&k>0
];
Sphere[#,r]&/@If[Length[p]>n,Take[p,n],p]
]

Then:

distinct3D[150, 0.2, 100]//Graphics3D That is 118 spheres.

I'd show you one in four dimensions, except that there's no HyperSphere[] or Graphics4D[]. Perhaps someone could work on those.

And now for something completely different. @novice did not ask that the circles be placed randomly, rather that the circles be distributed "uniformly". You can get more circles in if they are not placed randomly. This hexagonally packs in as many circles as possible of radius r, and then removes any excess circles randomly:

distinctx[n_,r_]:=Module[{x,c},
x={
2Floor[1/(2r)+1/2]-1,
2Floor[1/(2r)],
Sqrt(2Floor[1/(2Sqrtr)+1/2]-1),
2SqrtFloor[1/(2Sqrtr)]}//
Min[1/Select[#,#>0&]]&;
c=Join[
Table[Circle[x{2 i+1,Sqrtj},r],
{i,-Floor[1/(2x)+1/2],Floor[1/(2x)-1/2]},
{j,-1-2Floor[1/(2Sqrtx)-1/2],1+2Floor[1/(2Sqrtx)-1/2],2}]
//Flatten,
Table[Circle[x{2 i,Sqrtj},r],
{i,-Floor[1/(2x)],Floor[1/(2x)]},
{j,-2Floor[1/(2Sqrtx)],2Floor[1/(2Sqrtx)],2}]
//Flatten];
If[Length[c]>n,RandomSample[c,n],c]
]

For example:

distinctx[10,0.15]//
Graphics[{Blue,Line[{{-1,-1},{-1,1},{1,1},{1,-1},{-1,-1}}],Black,#}]& distinctx[40,0.15]//
Graphics[{Blue,Line[{{-1,-1},{-1,1},{1,1},{1,-1},{-1,-1}}],Black,#}]& You're very unlikely to be able to get 40 circles of radius 0.15 stuffed in there randomly.

• '@Mark Adler, thanks. Your method is faster than mine(especially when n is large), and the generated circles are close to uniform distribution. Dec 25 '14 at 5:24
• @MarkAdler very nice. I noticed that having 'RandomReal' produce three numbers '{n,3}' and using 'Sphere' instead of 'Circle' produces perfect collections of spheres in 3D. Dec 25 '14 at 12:43

Here's one way to approach this: generate a collection of random circles and then throw out all those that are too close to another. For example, generate 20 centers with a box of size {-5,5} and with radius 1. Then throw out those that overlap others.

n = 20; rad = 1; centers = RandomReal[{-5, 5}, {n, 2}];
allCircles = Table[near = Nearest[centers, centers[[i]], 2]; test = First@Rest@near;
If[Norm[First@near - test] < 2 rad, centers[[i]] = {-100, 100}, centers[[i]]], {i, 1, n}];
circles = Select[allCircles, # != {-100, 100} &];  