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.
-
2$\begingroup$ …and you want to do this with Mathematica the software? $\endgroup$– J. M.'s missing motivation ♦Sep 2, 2015 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$– InariSep 2, 2015 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 ItanSep 2, 2015 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$– InariSep 2, 2015 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 SeifertSep 2, 2015 at 14:55
4 Answers
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]}]
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.
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]]]]}]
Thanks to @george2079 for introducing me to MinimalBy
; my plotting command is also shamelessly lifted/adapted from his answer.
-
$\begingroup$ Typo fixed. Thanks for the heads-up! $\endgroup$ Sep 3, 2015 at 12:51
-
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}
]
-
$\begingroup$ I don't see any overlap area calculated? Which are the 10/20 points where the optimization would place the circles centers? $\endgroup$ Sep 2, 2015 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$– rhermansSep 2, 2015 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$ Sep 2, 2015 at 16:03