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?

$\endgroup$
6
  • $\begingroup$ (1. + 2 $MachineEpsilon) already works and (1.-$MachineEpsilon) too (instead of 1.1). How special is this special case? $\endgroup$
    – Rojo
    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

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.

$\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

$\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

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.