How to find intersection points of several circles in Graphics without using Solve[ ]?

Question

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?

Are you going to take this question to https://codegolf.stackexchange.com, or can I? — Michael Stern, Jan 26 '21 at 01:57

cvgmt · Accepted Answer · 2021-01-25T11:16:56.423

7

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]}]]

edited Jan 25 '21 at 11:16

answered Jan 25 '21 at 10:08

cvgmt

72,231
4
75
133

Graphics`Mesh`FindIntersections was my first inclination too - but it seems to produce additional points not corresponding to an intersection.. – George Varnavides Jan 25 '21 at 10:41
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? – DORA Jan 25 '21 at 11:02
@DORA Since this is an undocument function. – cvgmt Jan 25 '21 at 11:12
@DORA FindIntersections is unreliable as can be seen above and here: Graphics`Mesh`FindIntersections[ ] fails to detect intersections Graphics`Mesh`FindIntersections get extra intersections – Michael E2 Jan 25 '21 at 13:36

score 6 · Answer 2 · answered Jan 25 '21 at 09:57

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]}]

How to find intersection points of several circles in Graphics without using Solve[ ]?

2 Answers2