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?
Mathematica Stack Exchange is a question and answer site for users of Wolfram Mathematica. It only takes a minute to sign up.
Sign up to join this communityFor 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?
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]}]]
Graphics`Mesh`FindIntersections
was my first inclination too - but it seems to produce additional points not corresponding to an intersection..
$\endgroup$
Jan 25, 2021 at 10:41
Graphics`Mesh`FindIntersections
" and "Graphics`Mesh`AllPoints
" are blue, are they undefined in Mathematica?
$\endgroup$
FindIntersections
is unreliable as can be seen above and here: Graphics`Mesh`FindIntersections[ ]
fails to detect intersections Graphics`Mesh`FindIntersections
get extra intersections
$\endgroup$
Jan 25, 2021 at 13:36
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]}]