Efficiently fill an ellipse with a k-many random ellipses

Question

So, I can create a circle filled with circles of the same radius that gives this example picture:

with this code:

generateCirclesSameRadius[numCircles_Integer, boundaryRadius_, circleRadius_, maxAttempts_Integer] :=
 Module[{circles = {}, attempt = 0, newCircle, canPlace},
  While[Length[circles] < numCircles && attempt < maxAttempts,
   newCircle = RandomPoint[Disk[{0, 0}, boundaryRadius - circleRadius]];
   canPlace = True;
   Do[
    If[Norm[newCircle - circle] < 2 circleRadius, canPlace = False; Break[];],
    {circle, circles[[All, 2]]}
    ];
   If[canPlace, AppendTo[circles, {circleRadius, newCircle}]];
   attempt++;
   ];
  circles
  ]
drawCircles[circles_] :=
 Graphics[{EdgeForm[Black], FaceForm[None], Circle[{0, 0}, boundaryRadius], 
   FaceForm[RandomColor[]], Circle[#[[2]], #[[1]]] & /@ circles}]
fixedRadius = 0.1; (* Adjust based on the boundary radius and desired number of circles )
boundaryRadius = 2;
numCircles = 10; ( Adjust based on available space and circle radius *)
maxAttempts = 100;
circles = generateCirclesSameRadius[numCircles, boundaryRadius, fixedRadius, maxAttempts];
drawCircles[circles]

And I can check overlaps of an ellipse with this code:

OverlapQ[ellipse1_List, ellipse2_List] := 
Module[
  {a, b, \[Alpha], \[Beta], c, d, \[Delta], \[Gamma], ell1, ell2, int, realIntersectionExists},
(* Extract ellipse parameters from the lists *)
  {a, b, [Alpha], [Beta]} = ellipse1;
  {c, d, [Delta], [Gamma]} = ellipse2;
(* Define the parametric equations for the ellipses *)
  ell1[t_] := {a Cos[t] + [Alpha], b Sin[t] + [Beta]};
  ell2[t_] := {c Cos[t] + [Delta], d Sin[t] + [Gamma]};
(* Solve for intersection points, focusing on real solutions *)
  int = Quiet[Solve[ell1[t] == ell2[s], {s, t}]];
(* Determine if there is at least one real intersection point *)
  realIntersectionExists = Length[Select[int, FreeQ[#, Complex] &]] > 0;
(* Return True if there is at least one actual intersection, else False *)
  realIntersectionExists
]

Which can be called with:

ellipse1 = {1, 0.5, 0, 0};
ellipse2 = {0.8, 0.9, 1, 1}; 
OverlapQ[ellipse1, ellipse2]

(gives True)

But I feel like there should be a more efficient way than to check the overlap of each this way or at least a more compact, readable method to do this. This is a very general problem that I think many people would use if solved.

Answer 1

• We re-write the code from the document of RegionDisjoint https://reference.wolfram.com/language/ref/RegionDisjoint.html

Clear["Global`*"];
reg = Ellipsoid[{0, 0}, {10, 5}];
randomEllipsoid := 
  TransformedRegion[
   DiscretizeRegion@Disk[RandomPoint[reg], RandomReal[{.1, 3}]], 
   ScalingTransform[RandomReal[{1.2, 1.5}], RandomPoint[Circle[]]]];
randomEllipsoidIn := 
 Block[{temp = randomEllipsoid}, 
  While[! RegionWithin[reg, temp], temp = randomEllipsoid];
  temp]
appendDisjoinEllipsoid[regs_] := 
 Block[{ellipse = randomEllipsoidIn}, 
  While[! (RegionDisjoint @@ Join[{ellipse}, regs]), 
   ellipse = randomEllipsoidIn];
  Join[{ellipse}, regs]]
disjointEllipsoids[n_] := 
 Nest[appendDisjoinEllipsoid, {randomEllipsoidIn}, n - 1]
k = 50;
Graphics[{{FaceForm[], EdgeForm[Cyan], reg}, {RandomColor[], #} & /@ 
   disjointEllipsoids[k]}]

• k=50 ellipses

• k=150 ellipses

• 3D version

reg = Ellipsoid[{0, 0, 0}, {10, 8, 5}];
randomEllipsoid := 
  TransformedRegion[
   DiscretizeRegion@Ball[RandomPoint[reg], RandomReal[{.1, 3}]], 
   ScalingTransform[RandomReal[{1.2, 1.5}], RandomPoint[Sphere[]]]@*
    ScalingTransform[RandomReal[{1.2, 1.5}], RandomPoint[Sphere[]]]];
randomEllipsoidIn := 
 Block[{temp = randomEllipsoid}, 
  While[! RegionWithin[reg, temp], temp = randomEllipsoid];
  temp]
appendDisjoinEllipsoid[regs_] := 
 Block[{ellipse = randomEllipsoidIn}, 
  While[! (RegionDisjoint @@ Join[{ellipse}, regs]), 
   ellipse = randomEllipsoidIn];
  Join[{ellipse}, regs]]
disjointEllipsoids[n_] := 
 Nest[appendDisjoinEllipsoid, {randomEllipsoidIn}, n - 1]
k = 20;
Graphics3D[{{Opacity[.2], 
   reg}, {EdgeForm[], FaceForm[RandomColor[]], #} & /@ 
   disjointEllipsoids[k]}, Boxed -> False]

Answer 2

One way to get non-overlapping ellipses is to place their centers far enough apart that they don't overlap no matter how they are oriented: use HardcorePointProcess to determine the centers, within a smaller version of the large ellipse so the ellipses around those centers are within that large ellipse.

For example:

center = {1, 0}; a = 2; b = 1; r = 0.2;
ellipse = Disk[center, {a, b}];
reg = RegionErosion[ellipse, r];
pts = RandomPointConfiguration[HardcorePointProcess[20, 2 r, 2], reg];
Graphics[{Style[ellipse, FaceForm[None], EdgeForm[Black]], 
  Disk[pts["Points"], r {1, 1/2}]}]

Each evaluation gives a new set of random locations.

If instead you'd like random rotations for the ellipses, change the last line to:

Graphics[{Style[ellipse, FaceForm[None], EdgeForm[Black]], 
  GeometricTransformation[Disk[#, r {1, 1/2}], 
     RotationTransform[RandomReal[{0, 2 \[Pi]}], #]] & /@ 
   pts["Points"]}]

This method of placing centers work for any orientation of ellipses, so is a 'worst case' spacing of the centers. So it does not pack centers closer if the ellipses wouldn't overlap due to their orientation. This avoids needing to test whether ellipses overlap.

For different sizes or shapes, change Disk[#, r {1, 1/2}] to vary the values in the 2nd argument. Just be sure they don't exceed r, to avoid overlaps.

For example, for different sizes but the same shapes, you could use Disk[#, r RandomReal[{0.3, 1}] {1, 1/2}]:

For different sizes and shapes, e.g., Disk[#, r RandomReal[{0.2, 1}, 2]]:

Answer 3

Using DiscretizeRegion: (as a guide)

Clear["Global`*"];
d2 = Disk[];
dreg = DiscretizeRegion[d2, MaxCellMeasure -> {1 -> 0.3}]

If the shape changes, the discretized region will change and so this strategy will work with any shape.

---

At this point Insphere should have come to the rescue, and please do try that with newer versions. I am using v12.2.0. I am resorting to a workaround.

---

The strategy is to get all polygons, find their centroids and the minimum distance from each centroid to the boundaries and place a circle in there.

polys2 = MeshPrimitives[dreg, 2];
cent = RegionCentroid /@ polys2;
mind = EuclideanDistance @@ {RegionCentroid@#, 
      RegionNearest[RegionBoundary@#, RegionCentroid@#]} & /@ polys2;
circles1 = 
 MapThread[Circle[#1, #2] &, {cent, mind}] // 
  Graphics[{#, d2 /. Disk -> Circle}] &

---

If you want to get circles that are of the same size, do some filtering with a threshold.

pos = Position[mind, _?(# > 0.03 &)];
circles2 = 
 MapThread[{RandomColor[], Circle[#1, 0.03]} &, {Extract[cent, pos], 
    Extract[mind, pos]}] // Graphics[{#, d2 /. Disk -> Circle}] &

---

Show[circles1, circles2]

---

If you can fit a circle inside a polygon, you can also fit an ellipse whose major axis will fit in there, although this may not be optimal in terms of packing. If you decide to fit ellipses in circles, these can be given a random rotation without violating the boundaries and causing overlap.