Generate randomly sized non-overlapping disks?

Question

I need to generate an image of $n$ randomly sized but non-overlapping blobs in a fixed rectangular region; for example, a square of 300 pixels.

The blobs could be disks to keep things simple. The non-overlapping part is tricky; this is what I have so far:

Clear @ pair;
pair[n_] := Module[{pts=RandomReal[1,{n,2}]},
    Image @ Rasterize[Graphics[{{PointSize@RandomReal[{0,.5}],Point[#]}&/@pts},
        PlotRange->{{0,1},{0,1}},PlotRangePadding->Scaled[.1]],
        ImageSize->300]->n
]

As you can see the ten disks are overlapping:

What is the question? It seems fairly clear that the code shown will generate blobs, and that there is nothing to force them to not overlap.Are you looking for advice on how to separate them? How to generate and accept/reject based on overlap? Something else? — Daniel Lichtblau, Sep 16 '16 at 17:05
The question is, how to create an mxm image with n non-overlapping disks of varying size. — M.R., Sep 16 '16 at 17:09
Might find something usable in responses to this prior MSE post — Daniel Lichtblau, Sep 16 '16 at 17:11

score 20 · Accepted Answer · edited Apr 13 '17 at 12:55

Just a quick modification of the code here,

distinctDisks[n_, range_:{0, 1}, radiusRange_:{0.03, 0.15}] := Module[
     {d, f, p, r},
      d = {Disk[RandomReal[range, 2], RandomReal[radiusRange]]};
      Do[f = RegionDistance[RegionUnion @@ d];
       While[
        r = RandomReal[radiusRange];
        p = RandomReal[range, 2];
        f[p] < r];
       d = Append[d, Disk[p, r]], {n - 1}];
      d]

distinctDisks[25, {0, 5}, {0, 2}] // Graphics

Mathematica graphics

score 9 · Answer 2 · answered Dec 10 '16 at 04:22

Here's my take. It should work in earlier versions that do not yet have region-related functionality:

distinctDisks[n_Integer?Positive, {xmin_, xmax_}, {ymin_, ymax_}, {rmin_, rmax_}] := 
    Module[{df = Max[0, EuclideanDistance[#1[[1]], #2[[1]]] - (#1[[2]] + #2[[2]])] &,
            dlist = {}, k = 0, c, d, r},
           While[c = RandomReal /@ {{xmin, xmax}, {ymin, ymax}};
                 r = RandomReal[{rmin, rmax}]; 
                 If[k == 0 || (Min[c[[1]] - xmin, xmax - c[[1]],
                                   c[[2]] - ymin, ymax - c[[2]]] > r && 
                               df[First[Nearest[dlist, d = Disk[c, r],
                                                DistanceFunction -> df]], d] > 0),
                    k++; AppendTo[dlist, d]]; k < n]; dlist]

An example:

BlockRandom[SeedRandom["many disks"]; (* for reproducibility *)
            Graphics[Riffle[distinctDisks[150, {0, 5}, {0, 3}, {1/20, 3/2}], 
                            Unevaluated[ColorData[61, RandomInteger[{1, 9}]]],
                            {1, -2, 2}], PlotRange -> {{0, 5}, {0, 3}}]]

randomly placed disks

Hi, sorry for necroing this but I came across this post and after checking the timing found your solution to be fastest. I'm going through the code trying to understand it and was wondering if you could explain the If function in the code. In particular, I'm not sure what "df[First[Nearest[dlist, d = Disk[c, r], DistanceFunction -> df]], d] > 0)" does. Thanks. — Letshin, Jul 11 '18 at 19:14
@Zhao, you can break it up into steps: d = Disk[c, r] is the candidate disk being tested for inclusion into dlist. From there, Nearest[dlist, d, DistanceFunction -> df] uses the metric function df to pick out which of the disks already in dlist are nearest to d. You then compute the "distance" of that (after applying First[]) from d with df. The positivity condition implies that d should not intersect the nearest disk, before it can be included into dlist (AppendTo[dlist, d]). — J. M.'s missing motivation, Sep 24 '18 at 11:13

score 5 · Answer 3 · edited Dec 17 '16 at 10:45

I have to say, I have seen this question many times in SE, but it's difficult for me to find the duplicate post. Thus, I post my answer again:

disk = Reap[
   region = 
    RegionUnion[
     BoundaryDiscretizeGraphics[
        CountryData[#, "Polygon"]] & /@ {"China", "Taiwan"}]; 
   Do[p = RandomPoint[region]; 
    rad = If[(tem = Abs[SignedRegionDistance[region, p]]) < .2, tem, 
      RandomReal[{.2, 
        Min[{tem, Min@(Subtract @@ RegionBounds@region)/40}]}]]; 
    region = 
     RegionDifference[region, DiscretizeRegion@Sow[Disk[p, rad]]], 
    2500]][[-1, -1]]; Graphics[
 Transpose[{RandomColor[
    Hue[1/3, NormalDistribution[.6, .2], NormalDistribution[.6, .07]],
     disk // Length], disk}]]

It is composed of 2500 disks. This low-efficiency code's main time is taken up by RegionDifference. But you can produce any shape by changing region.

Generate randomly sized non-overlapping disks?

3 Answers3

Linked