26
$\begingroup$

Graphics`Mesh`FindIntersections[ ] is an undocumented function for, well, detecting intersections very efficiently. Take a look:

i = Import@"https://i.sstatic.net/PcWcz.png"; perim = ImageValuePositions[Thinning@EdgeDetect@i, 1]; fcp = FindCurvePath[perim]; perimPts = perim[[First@fcp]]; Graphics`Mesh`MeshInit[]; (*not sure if needed*) myLine = Line@{1.1 {750.5`, 955.5`}, {182.5`, 671.5`}}; pts = Graphics`Mesh`FindIntersections[{myLine, Polygon@perimPts}]; Graphics[{Line@perimPts, Red, myLine, Green, PointSize[Large], Point@pts}, AspectRatio -> Automatic]

Mathematica graphics

But it doesn't work consistently (here I change myLine):

myLine = {Line@{{750.5`, 955.5`}, {182.5`, 671.5`}}, Line@{{622.5`, 1031.5`}, {222.5`, 831.5`}}}; pts = Graphics`Mesh`FindIntersections[{#, Polygon@perimPts}] & /@ myLine; Graphics[{Line@perimPts, Red, Sequence @@ myLine, Green, PointSize[Large], Point /@ pts}, AspectRatio -> Automatic]

Mathematica graphics

Is there something that can be done about this behavior?

Improve this question
$\endgroup$
6
  • $\begingroup$ (1. + 2 $MachineEpsilon) already works and (1.-$MachineEpsilon) too (instead of 1.1). How special is this special case? $\endgroup$ Commented Jan 31, 2014 at 18:21
  • $\begingroup$ @Rojo Not special at all. It fails a lot $\endgroup$ Commented Jan 31, 2014 at 18:26
  • 1
    $\begingroup$ I've come across this problem before, sadly I know of no way to fix it :-( $\endgroup$ Commented Jan 31, 2014 at 20:44
  • $\begingroup$ @SimonWoods Thanks for letting me know. I was almost thinking I'm the only one! $\endgroup$ Commented Jan 31, 2014 at 21:28
  • 2
    $\begingroup$ Using InfiniteLine[] instead of Line[] might work( tested with the code of Ali Hashmi-answer) ! $\endgroup$ Commented Jan 20, 2018 at 11:09

2 Answers 2

Reset to default
4
$\begingroup$

(Not an answer, just an illustrated comment)

Let us look closer where the points missing on the plot shown by the OP are located:

Graphics[{Blue, Line@perimPts, PointSize[Large], Point@perimPts, Red, myLine}, AspectRatio -> Automatic, Frame -> True, PlotRange -> #, GridLines -> Automatic] & /@ {{{323, 326}, {881, 884}}, {{624, 626}, {892, 894}}, {{548, 550}, {994, 996}}}

output

Two missing intersection points are located exactly at the nodes of the polyline, while the third point isn't.

Improve this answer
$\endgroup$
3
$\begingroup$

I think the problem might be in the way we preprocess the image. Here is a fix:

(* finding the boundary *) i = Import@"https://i.sstatic.net/PcWcz.png"; img = MorphologicalPerimeter@Binarize@FillingTransform@ColorNegate@i; boundaryx = PixelValuePositions[img, 1]; path = FindShortestTour[boundaryx][[2]]; boundaryx = boundaryx[[path]]; myLine = Line@{1.1 {750.5`, 955.5`}, {182.5`, 671.5`}}; gr = Graphics[{FaceForm[], EdgeForm[Blue], Polygon@boundaryx, Red, myLine}]; pts = Graphics`Mesh`FindIntersections[ Graphics[{FaceForm[], EdgeForm[Blue], Polygon@boundaryx, myLine}]]; Show[gr, Graphics[{Red, PointSize[Large], Darker@Green, Point@pts}]]

enter image description here

myLine = {Line@{{750.5`, 955.5`}, {182.5`, 671.5`}}, Line@{{622.5`, 1031.5`}, {222.5`, 831.5`}}}; gr = Graphics[{FaceForm[], EdgeForm[Blue], Polygon@boundaryx, myLine}]; pts = Graphics`Mesh`FindIntersections[{#, Polygon@boundaryx}] & /@ myLine; Show[gr, Graphics[{Red,Sequence @@ myLine,Darker@Green, PointSize[Large], Point /@ pts}, AspectRatio -> Automatic]]

enter image description here

Improve this answer
$\endgroup$
1
  • $\begingroup$ It is interesting that with the perimPts of OP Graphics`Mesh`FindIntersections works correctly if we apply Ceiling of Floor to perimPts, but applying Round reveals another bug. $\endgroup$ Commented Jan 20, 2018 at 12:17

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.