4
$\begingroup$

Suppose I am plotting random circles like in the following example: m=125;

g10=Graphics[{Table[Circle[pt[i],r],{i,m}]},Axes- 
>True,PlotRange->{{-5000,5000},{-5000,5000}}]

Some of the circles may overlap. How can I calculate the whole overlapped area (Integrate it) and the ratio of this overlapped area to the integrated circles area (Here 125*Pi*r2)?

$\endgroup$
  • 2
    $\begingroup$ What are the values of pt, r and m $\endgroup$ – happy fish May 21 '16 at 11:47
  • $\begingroup$ r=469. The value of m may change. If it is about 150 (for example) sounds like all given solution are very slow calculated/ $\endgroup$ – Danny May 21 '16 at 15:36
  • $\begingroup$ Could you please clarify what you mean by overlapping area? Do you mean the area overlapped by all circles (the intersection of all circles)? Or do you mean the area where any two circles overlap? Or do you simply want the sum of all unique regions covered by any circle? (I asked because r=469 is sort of an intermediate region where most circles overlap with one or two others, but there will be no intersection of all circles.) I would be glad to try and accelerate my answer based on your goal. $\endgroup$ – Rashid May 22 '16 at 15:54
  • $\begingroup$ Thx for your comment. I mean overlapped area of all circles. Having 25 circles is fine, but 125 will take 10's mins calculation. Regards. Danny $\endgroup$ – Danny May 24 '16 at 18:42
8
$\begingroup$
m = 5; r = 3000;
Table[pt[i] = RandomReal[{-2000,2000},2], {i, m}];
circles = Table[Circle[pt[i], r], {i, m}];
disks = circles /. Circle -> Disk;
reg1 = RegionIntersection[disks];
area1 = RegionMeasure[reg1];
reg2 = RegionUnion[disks];
area2 = RegionMeasure[reg2];
g10 = Show[Graphics[{RandomColor[], #}& /@ circles, Axes-> True, 
           PlotRange->{{-5000, 5000}, {-5000, 5000}}],
      RegionPlot[reg1], PlotLabel->Row[{"ratio = ", area1 / area2}]]

Mathematica graphics

| improve this answer | |
$\endgroup$
  • $\begingroup$ great answer +1. It was interesting to see how this question could be interpreted in different ways, depending on the r value. $\endgroup$ – Rashid May 21 '16 at 12:46
  • 1
    $\begingroup$ @Rashid, thank you for the upvote. I chose the lazier/easier way out in interpreting the question :) $\endgroup$ – kglr May 21 '16 at 12:51
7
$\begingroup$

@kglr beat me to posting and has a much nicer answer, but since I interpreted the question slightly differently, I thought it might be helpful to post my answer too.

(Edit: Updated based on comment by @JackLaVigne to accelerate by getting rid of empty intersections, see module below for timing.)

Since OP says that "some of the circles may overlap", I assumed that $r$ might be much smaller than the PlotRange and that the goal was to find regions with any overlap (between 2 or more circles).

First, we can construct and plot the set of allCircles (using Disks as opposed to Circles so that we can use the Area function later):

m = 125;
r = 100;
pt[i_] := RandomReal[{-4000, 4000}, 2];
allCircles = Table[Disk[pt[i], r], {i, m}];
g10 = Graphics[allCircles, Axes -> True, PlotRange -> {{-5000, 5000}, {-5000, 5000}}]

enter image description here

Then, we can calculate the total area (sum of all circles):

totalArea = Total[Map[Area, allCircles]];
(*3.92699*10^6*)

Next, we can consider the RegionIntersection for all two circle subsets (using @JackLaVigne's suggestion to get rid of empty intersections) and calculate the overlap/total ratio:

circlePairs = Map[RegionIntersection, Subsets[allCircles, {2}]]/.emptyRegion[2]->Nothing;
overlappingArea = Total[Map[Area, circlePairs]]
(*99293.3 for the plotted case above*)

areaRatio = overlappingArea/totalArea
(*0.0252848 for the plotted case above*)

This calculations assumes there they are no overlapping regions between more than two circles. The circlePairs area would double count such regions, but that could be corrected by considering the overlaps of, for example, circleTriplets.

EDIT Here is a Module form that runs in 6-10 seconds on my laptop for m=125 and r=100:

overlapAreaModule[shapes_] :=
 Module[{totalArea, shapePairs, overlappingArea, areaRatio},
  totalArea = Total[Map[Area, shapes]];
  shapePairs = 
   Map[RegionIntersection, Subsets[shapes, {2}]] /. 
    EmptyRegion[2] -> Nothing;
  overlappingArea = Total[Map[Area, shapePairs]];
  areaRatio = overlappingArea/totalArea;
  Print["Overlap ratio is ", areaRatio, "( ", overlappingArea, " / ", 
    totalArea, " )"]; Print[Graphics[shapes, Axes -> True]];
  {areaRatio, overlappingArea, totalArea}]

m = 125;
r = 100;
pt[i_] := RandomReal[{-5000, 5000}, 2];
allCircles = Table[Disk[pt[i], r], {i, m}];
AbsoluteTiming[overlapAreaModule[allCircles]]
| improve this answer | |
$\endgroup$
  • $\begingroup$ Upvote for awareness and sportsmanship $\endgroup$ – user9660 May 21 '16 at 13:15
  • $\begingroup$ Thanks @Louis. I appreciate it. $\endgroup$ – Rashid May 21 '16 at 13:19
  • 2
    $\begingroup$ @Rashid Great answer! I found the last stop could be sped up if we compute a new quantity nonEmpty = circlePairs /. EmptyRegion[2] -> Nothing; and then used that in the computation of overlappingArea. The substitution is very fast and nonEmpty is much smaller than circlePairs. $\endgroup$ – Jack LaVigne May 22 '16 at 14:10
  • $\begingroup$ Thanks @JackLaVigne, I will update post to include that. Getting rid of the empty intersections like that really speeds things up. $\endgroup$ – Rashid May 22 '16 at 15:55

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.