3
$\begingroup$

For example, I randomly plot some circle in Graphics[]:

Graphics[{Table[{Circle[{RandomInteger[5], RandomInteger[5]}, r]}, {r,
     1, 5}]}]

How to find all the intersections in the picture?

$\endgroup$
2
7
$\begingroup$
circles = 
  Table[Circle[{RandomInteger[5], RandomInteger[5]}, r], {r, 1, 5}];
pts = Table[
   RegionIntersection[circles[[i]], circles[[j]]], {i, 5}, {j, i - 1}];
Graphics[{circles, PointSize[Large], Red, pts}]

Or

fig = Graphics[
   Table[Circle[{RandomInteger[5], RandomInteger[5]}, r], {r, 1, 5}]];
pts = Graphics`Mesh`FindIntersections[fig, 
   Graphics`Mesh`AllPoints -> False];
Show[fig, Graphics[{PointSize[Large], Red, Point[pts]}]]

enter image description here

$\endgroup$
4
  • $\begingroup$ Graphics`Mesh`FindIntersections was my first inclination too - but it seems to produce additional points not corresponding to an intersection.. $\endgroup$ – George Varnavides Jan 25 at 10:41
  • $\begingroup$ thank you, it's the simplest code to get the intersections, but when i copy it onto my notebook, the text color of "Graphics`Mesh`FindIntersections" and "Graphics`Mesh`AllPoints" are blue, are they undefined in Mathematica? $\endgroup$ – DORA Jan 25 at 11:02
  • $\begingroup$ @DORA Since this is an undocument function. $\endgroup$ – cvgmt Jan 25 at 11:12
  • $\begingroup$ @DORA FindIntersections is unreliable as can be seen above and here: Graphics`Mesh`FindIntersections[ ] fails to detect intersections Graphics`Mesh`FindIntersections get extra intersections $\endgroup$ – Michael E2 Jan 25 at 13:36
6
$\begingroup$

I solved this problem for something else a while back. I needed it to be fast, so I used compile.

I started out by finding the exact solution symbolically. I used that result to create the helper functions.

Thanks to George Varnavides for calling my attention to your post.

rootSq = Compile[{{distanceSquared, _Real}, {r1, _Real}, {r2, \
_Real}}, -(distanceSquared - r1^2)^2 + 
    2 (distanceSquared + r1^2) r2^2 - r2^4, 
   CompilationTarget :> "C"];

bxby = Compile[{{distanceSquared, _Real}, {r1, _Real}, {r2, _Real}, \
{dx, _Real}, {dy, _Real}},
   {dx, dy} (distanceSquared + r1^2 - r2^2), CompilationTarget :> "C"];
circleIntersectionsXYExact[circle1 : {{x1_, y1_}, r1_}, 
   circle2 : {{x2_, y2_}, r2_}] := 
  Module[{x, y, dx, dy, denom, distanceSquared, distance, bx, by, 
    rootSquared, root, temp}, dx = x2 - x1;
   dy = y2 - y1;
   distanceSquared = (dx^2 + dy^2);
   distance = Sqrt[distanceSquared];
   rootSquared = rootSq[distanceSquared, r1, r2];
   If[rootSquared < 0, Return[{}]];
   root = Sqrt[rootSquared];
   {bx, by} = bxby[distanceSquared, r1, r2, dx, dy];
   {{x1, y1} + {bx - dy root, by + dx root}/(2 distanceSquared), {x1, 
      y1} + {bx + dy root, by - dx root}/(2 distanceSquared)}];

circles = 
  Table[Circle[{RandomInteger[5], RandomInteger[5]}, r], {r, 1, 5}];

intersections = 
 Flatten[circleIntersectionsXYExact @@@ 
   Subsets[circles /. Circle[x_, r_] :> {x, r}, {2}], 1]

Graphics[{circles, Red, PointSize[Large], Point[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.