26
$\begingroup$

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

i = Import@"http://i.stack.imgur.com/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$
  • $\begingroup$ (1. + 2 $MachineEpsilon) already works and (1.-$MachineEpsilon) too (instead of 1.1). How special is this special case? $\endgroup$ – Rojo Jan 31 '14 at 18:21
  • $\begingroup$ @Rojo Not special at all. It fails a lot $\endgroup$ – Dr. belisarius Jan 31 '14 at 18:26
  • 1
    $\begingroup$ I've come across this problem before, sadly I know of no way to fix it :-( $\endgroup$ – Simon Woods Jan 31 '14 at 20:44
  • $\begingroup$ @SimonWoods Thanks for letting me know. I was almost thinking I'm the only one! $\endgroup$ – Dr. belisarius Jan 31 '14 at 21:28
  • 2
    $\begingroup$ Using InfiniteLine[] instead of Line[] might work( tested with the code of Ali Hashmi-answer) ! $\endgroup$ – Ulrich Neumann Jan 20 '18 at 11:09
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@"http://i.stack.imgur.com/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$
  • $\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$ – Alexey Popkov Jan 20 '18 at 12:17

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.