2
$\begingroup$

Opening note:

MarcoB edited the initial question--modifying the title and J. M.'s technical difficulties appropriately indicated that the Disk command should be the one under examination and not Circle (which I now see simply refers to the one-dimensional boundary, rather than the two-dimensional interior.) He also--in his comment--asked for "all those previous attempts that did not meet with success".

However, I did have a very successful related (three-dimensional) attempt--documented in my answer to Create a Venn and/or related diagrams given the eight atoms of a three-set (A,B,C) 256-dimensional Boolean algebra

What my objective here is to represent (as best as possible) the same set of results, but now in a two-dimensional ("Venn-type") diagram. Since Disk allows for different semi-axes (rather than a single radius), this interestingly seems to attractively allow more degrees of fitting. So, I remain interested in a computational approach to constructing (now) $n$ disks the $n(n-1)/2)$ intersections of which assume a given set of values. But, once again as J. M.'s technical difficulties's example--Solve[Area[RegionIntersection[Disk[], Disk[{h, 0}, 1]]] == π/5, h]--yielding {}, indicates, it seems that one needs to employ other more traditional equation formulations, rather than making use of the specialized Disk, RegionMeasure, RegionIntersection... commands.



Modified initial question:

I want to try to construct $n$ disks--of given areas--such that their $n(n-1)/2$ areas of intersection assume certain given values.

Can I employ Disk objects--with unknown coordinates/semi-axes in such an endeavor (along with, say, Solve or FindFit,...)?

Initial efforts to do so seemed negative.

If not, how might one set up an appropriate system of equations?

I briefly tried employing RegionIntersection and RegionMeasure for such purposes, but I got the impression that this would be unproductive. This all pertains to the construction of Venn diagrams.

$\endgroup$
2
  • 3
    $\begingroup$ Since you're considering areas of intersection, it's Disk[] you should be interested in, and not Circle[]. Consider the following simple example: Solve[Area[RegionIntersection[Disk[], Disk[{h, 0}, 1]]] == π/5, h] $\endgroup$ May 24, 2020 at 14:05
  • $\begingroup$ It would be very helpful if you included all those previous attempts that did not meet with success. Even a minimal working example would be good. Otherwise the answer to your question is: “No, you should use Disk“, and the question will end up closed as easily found in the docs or as lacking details. $\endgroup$
    – MarcoB
    May 24, 2020 at 15:24

2 Answers 2

3
$\begingroup$

It is true that the following (incorrectly?) evaluates to $0$ on its own, instead of either returning an explicit expression, or returning unevaluated:

Area[RegionIntersection[Disk[], Disk[{h, 0}, 1]]]              (* Out: 0 *)

I was surprised by that; @JM confirmed that version 11.2 returns a symbolic expression, as one would expect, so this appears to be a regression. I filed a report with Wolfram Support (Case: 4549068).

Update 2020-06-09: Wolfram Support replied that the behavior from v. 11.2 can be reproduced in v. 12 by adding GenerateConditions -> All, but did not address the $0$ result discussed above:

Area[
 RegionIntersection[Disk[], Disk[{h, 0}, 1]], 
 GenerateConditions -> All
]

symbolic result obtained using GenerateConditions


However, numerical evaluation works:

ClearAll[area]
area[h_?NumericQ] := Area[RegionIntersection[Disk[], Disk[{h, 0}, 1]]]

NSolve[area[h] == Pi/5, h]                  (* Out: {{h -> 1.3741}} *)
FindRoot[area[h] == Pi/5, {h, 0.5}]         (* Out:  {h -> 1.3741}  *)
$\endgroup$
7
  • 2
    $\begingroup$ The Area[] computation returns an elementary symbolic expression in 11.2; I guess something broke in later versions. $\endgroup$ May 24, 2020 at 17:09
  • $\begingroup$ So, more generally, how could I expand this example to try to fit all four parameters of Disk[{h1,h2},{h3,h4}]? $\endgroup$ May 24, 2020 at 17:43
  • $\begingroup$ I'm thinking in terms of having n Disks, the areas of intersection of pairs of which satisfy n(n-1)/2 given areas. So, with n (fully general) Disks, one would have 4 n parameters. For n< 9, we have 4 n > n(n-1)/2 < 4n, for n= 9, they are equal, and for n>9, we have n (n-1)/2>4 n. So, I have an n=8 case in mind per mathematica.stackexchange.com/questions/222341/… , having, I believe, five free parameters. I think I want the areas of intersection to be all zero, but the sums of the areas of the disks to $\endgroup$ May 24, 2020 at 18:10
  • $\begingroup$ satisfy additional (possibly up to 256) relations. More precise thinking needed on my part here, though. $\endgroup$ May 24, 2020 at 18:14
  • $\begingroup$ I meant that various sums of the eight disk areas should satisfy certain given relations, now just simply the (single) sum of all the eight areas (which can be set to 1). $\endgroup$ May 24, 2020 at 18:25
2
$\begingroup$

Here's how you can find approximate circle positions and radii given a list of intersection areas. I initially tried an exact approach with FindInstance but that would not complete execution for more than two circles.

If we use NMinimize instead we get some inaccuracy for more than three disks, but at least it gives a close answer. In the example below - it's almost exact anyway. If you start off with plausible target areas of intersection then you'll get good results.

(* All radii must be nonzero *)
radiusRequirement[disk_] := disk[[2]] > 0

(* Calculate the area between two disks. 
This accounts for cases when a disk is completely contained inside another, zero if too far apart *)
diskDiskArea[disk1_, disk2_] := 
 With[{d = EuclideanDistance[disk1[[1]], disk2[[1]]], r1 = disk1[[2]],
    r2 = disk2[[2]]},
  Which[d + r1 < r2, \[Pi]*r1^2, d + r2 < r1, \[Pi] r2^2, r1 + r2 < d,
    0, r1 + r2 > d,
    r1^2 ArcCos[(d^2 + r1^2 - r2^2)/(2 d r1)] + 
    r2^2 ArcCos[(d^2 + r2^2 - r1^2)/(2 d r2)] - 
    Sqrt[(-d + r1 - r2) (-d - r1 + r2) (-d + r1 + r2) (d + r1 + r2)]/2
   ]]

(* Setup the disk parameters *)
disks = {
   Disk[{x1, 0}, r1],
   Disk[{x2, 0}, r2],
   Disk[{x3, 0}, r3]
   };

(* Create a list of all possible pairs of disks *)
diskPairs = Subsets[disks, {2}];

(* Each pair has a target area - there must be n(n-1)/2 numbers here! *)
diskPairTargetAreas = {2.152, 0.351, 0.785};

(* Extract all the variables used by the disks *)
variables = 
  DeleteCases[DeleteDuplicates@Flatten[disks /. Disk -> List], 
   x_ /; NumericQ[x]];

(* Our objective function to minimize - 
 the total absolute difference between disk area and target area *)
objective = 
  Total@MapThread[
    Abs[diskDiskArea[#1[[1]], #1[[2]]] - #2] &, {diskPairs, 
     diskPairTargetAreas}];

(* Perform the minimization *)
{err, result} = 
  NMinimize[
   Join[{objective}, (radiusRequirement /@ disks), 
    Map[# \[Element] Reals &, variables]], variables];

(* RESULT: {2.152, 0.351, 0.785}
disks: {Disk[{1.05451, 0}, 1.32393], Disk[{-0.0865935, 0}, 1.17711], 
 Disk[{-0.279559, 0}, 0.499873]}
*)

(* Draw disks as circles *)
Graphics[(disks /. Disk -> Circle) /. result]
diskDiskArea @@@ (diskPairs /. result)

circle intersections

It also works if you add y0,y1,y2 in disks allowing you to vary the position in 2D. For the same target areas given above I calculated these disks

{Disk[{0.940631, -0.218092}, 0.827649], 
 Disk[{0.788642, 0.192716}, 1.37584], 
 Disk[{0.126464, -0.296553}, 0.499873]}

circles with 2d positions

For four or more circles you start running into problems. NMinimize will get trapped in a local optimum. One reason for this is the r1+r2<d,0 in the Which when calculating area. Basically when two circles are far apart there's no gradient to a better solution. I found changing that to r1+r2<d,-(r1+r2-d)^2 leads to better solutions. Also you could replace the Abs[...] in the objective function with minimizing the square error instead. Even so it still performs badly with more than three circles.

With these modifications I could get the occasional pleasing result e.g four circles with all intersections area 0.3 with my r3 and r4 forced to 1:

{Disk[{-1.11301, 3.13655}, 2.48723], 
 Disk[{0.200641, 1.02024}, 0.448032], Disk[{1.18276, 0.976557}, 1], 
 Disk[{-0.196003, 0.120715}, 1]}

four circle intersections

$\endgroup$

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.