5
$\begingroup$

I have 20 points in the 2D plane with $(x_i,y_i)$ coordinates. I want to use Mathematica to optimally distribute 10 circles with equal radius of a given positive value $R$, i.e. to determine with the optimization 10/20 of the existing points $(x_i,y_i)$ so that the circles area overlap is minimal.

$\endgroup$
  • 2
    $\begingroup$ …and you want to do this with Mathematica the software? $\endgroup$ – J. M. will be back soon Sep 2 '15 at 13:53
  • 1
    $\begingroup$ It would be nice to have a bit more details about your plans. What do the points and the circles have to do with each other? Be a bit more specific. Otherwise distribute the circles at x= 0R, 2R, 4R, ... and y= const :p $\endgroup$ – Inari Sep 2 '15 at 14:02
  • 1
    $\begingroup$ Just to make my question clear, I would like to place the 10 circles with radius R at the already excising (xi,yi) coordinates in the 2D plane. Therefore, the optimization would place the centers of the circles at 10/20 excising points (xi,yi) so that there is minimal overlap between circles areas. $\endgroup$ – Hunter Itan Sep 2 '15 at 14:16
  • 1
    $\begingroup$ The area of overlap for two circles in distance L < 2R is given by 4* integral_(0)^(arccos(L/2R) d\theta L/(8*cos(\theta)). A slow but working version would be to test out all ~184k possible choices, calculate the distances, sum up the overlaps and choose the minimum from a list. I'm positive with a bit of mathematica magic a quicker solution is possible $\endgroup$ – Inari Sep 2 '15 at 14:55
  • 1
    $\begingroup$ You might be able to do something using Mathematica's graph-theory tools. Construct a weighted graph where two nodes are connected with a weight given by the overlap that their circles would have (and zero weight if they don't overlap.) Then look for the set of 10 vertices whose induced subgraph has minimal total weight. Given that there are only ${20 \choose 10} = 184756$ possible vertex subsets, brute-forcing the solution should be possible (though there might be a more elegant way.) I don't have time to work through this myself just now, unfortunately. $\endgroup$ – Michael Seifert Sep 2 '15 at 14:55
9
$\begingroup$

Brute force approach. Update, now properly using formula for area overlap. (Note this does not properly handle cases of multiple overlap)

(
 points = RandomReal[{0, 1}, {20, 2}];
 R = .15;
 segarea[R_, L_ ] /; L < 2 R := 
      R^2 ( # - Sin@# ) &@( 2 ArcSin[Sqrt[1 - 1/4 (L/R)^2]] );
 segarea[R_, L_] = 0; 
 x = {#, Total[(segarea[R, Norm[Subtract @@ #]] & /@ 
      Subsets[#, {2}])]} & /@ Subsets[points, {10}];
 minset = MinimalBy[x, #[[2]] &][[1, 1]];
) // AbsoluteTiming // First

82.0024

Graphics[{Circle[#, R] & /@ minset,Point[points],Red,Point[minset]}]

enter image description here

$\endgroup$
6
$\begingroup$

Brute force

The data

points = RandomReal[{0, 1}, {20, 2}];

all the possible 10 Subsets (notice the differences with Tuples)

allsubsets = Subsets[points, {10}];

you can measure the overlapping using RegionIntersection and RegionMeasure

RegionMeasure[RegionIntersection @@ Thread[Disk[pair, r]]]

where r is the radius and pair the a list with the two coordinates of the Disk

Now we brute force calculate all the overlaps for all the pairs for all the possible Subsets

overlaplist = Table[
   Sum[
    N@RegionMeasure[RegionIntersection @@ Thread[Disk[pair, r]]]
    , {pair, Subsets[subset, {2}]}
    ], {subset, allsubsets}
   ];

Or, to find only one of the minima

MinimalBy[allsubsets, Sum[
   N@RegionMeasure[RegionIntersection @@ Thread[Disk[pair, 0.3]]]
   , {pair, Subsets[#, {2}]}] &
 , 1
 ]

This takes a lot of computation.

$\endgroup$
4
$\begingroup$

Here's an implementation of the brute-force approach I described above, with the graph theory bit omitted; it doesn't look like Mathematica has a canned algorithm to find the vertex subset I described. To save time, the code pre-computes the overlap areas in adjmat, and then looks for the sub-matrix of adjmat with the lowest sum of its entries.

points = RandomReal[{0, 1}, {20, 2}];
R = 0.15;
overlaparea[u_, v_] := If[EuclideanDistance[u, v] > 2 R || u == v, 0, R^2 ArcCos[EuclideanDistance[u, v]/(2 R)] - (EuclideanDistance[u, v]/2) Sqrt[R^2 - EuclideanDistance[u, v]^2/4]]; 
adjmat = Outer[overlaparea, points, points, 1, 1];
minset = MinimalBy[Subsets[Range[20], {10}], Total[adjmat[[#, #]], 2] &]
Graphics[{Circle[#, R] & /@ points[[First[minset]]], Point[points], Red, Point[points[[First[minset]]]]}]

enter image description here

Thanks to @george2079 for introducing me to MinimalBy; my plotting command is also shamelessly lifted/adapted from his answer.

$\endgroup$
  • $\begingroup$ Typo fixed. Thanks for the heads-up! $\endgroup$ – Michael Seifert Sep 3 '15 at 12:51
  • $\begingroup$ +1 about 10x faster than mine.. $\endgroup$ – george2079 Sep 3 '15 at 18:07
3
$\begingroup$

Your data:

points = RandomReal[{0, 1}, {20, 2}]

Find minimum distance:

r = Min@Select[EuclideanDistance @@@ Tuples[points, 2], Positive]

Graph

Graphics@Table[
  Circle[p, r/2]
  , {p, points}
  ]

Mathematica graphics

$\endgroup$
  • $\begingroup$ I don't see any overlap area calculated? Which are the 10/20 points where the optimization would place the circles centers? $\endgroup$ – Hunter Itan Sep 2 '15 at 14:39
  • 3
    $\begingroup$ Got the "complete explanation" after writing the reply. Here the overlap is by definition zero, nothing to optimize. You should have started by writing more clear question. $\endgroup$ – rhermans Sep 2 '15 at 14:40
  • 2
    $\begingroup$ I rather suspect the R is a prescribed parameter, not something you can pick to yield a trivial solution.. @HunterItan pleas edit the question with a clear description of the problem. $\endgroup$ – george2079 Sep 2 '15 at 16:03

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.