# How to extract data points from two graphics and find the intersections between them?

I am working on a mathematical problem called "Buffon's Needle". Here is the setup I made:

point[v_, u_] := Normalize[v - u] + u

experiment50 = Show[
Graphics[
Table[{
RGBColor[0, 0, 0],
Line[{{x, 0}, {x, 10}}]}, {x, 0, 10}]
],
Graphics[
Table[{
RGBColor[0.66, 0.38, 0.91],
u = {RandomReal[{0.5, 9.5}], RandomReal[{0.5, 9.5}]};
v = {RandomReal[{-100, 100}], RandomReal[{-100, 100}]};
Line[{point[v, u], u}]},
{50}]
]
]


I need to find how many purple segments are crossing the black lines. I thought about using FindRoot or extracting the plotted data points and finding points where the black lines and purple lines overlap, but I wasn't successful.

• Can you add the code how you tried to use FindRoot? Or any other method that you tried. – ercegovac Oct 13 '17 at 21:22
• is the base lines are parallel to the coordinate system (as this example) you only need to check if the one coordinate is on opposite sides of lines. This can be implemented much much faster than a geometric calculation. If the base lines are uniformly spaced it simplifies further... – george2079 Oct 13 '17 at 22:48
• Welcome to Mathematica.SE! I suggest the following: 1) As you receive help, try to give it too, by answering questions in your area of expertise. 2) Take the tour! 3) When you see good questions and answers, vote them up by clicking the gray triangles, because the credibility of the system is based on the reputation gained by users sharing their knowledge. Also, please remember to accept the answer, if any, that solves your problem, by clicking the checkmark sign! – Michael E2 Oct 13 '17 at 22:53

Update 3: With a method based RegionIntersection we can have arbitrary regions instead of vertical lines and get the intersection points conveniently. For example, using BezierCurves as the reference regions

cp =  Sort[RandomReal[10, {5,10, 2}]];
vlines = {Thick, RandomColor[], Line[BezierFunction[#] /@ Range[0, 1, .05]]} & /@ cp;


we get

As J.M. noted, if we need just the line segments intersecting vertical lines, this can be done using much simpler methods without the need for RegionIntersection. An alternative method to identify the segments cutting vertical lines with integer horizontal coordinates is

cutsGridQ = Ceiling[#[[1]]] <= Floor[#[[2]]] &@Sort[#[[All, 1]]] &;

SeedRandom[1]
randomcoords = {point[#2, #], #} & @@@ RandomReal[{.5, 9.5}, {50, 2, 2}];

Graphics[{Purple, Line /@ randomcoords,
Red, Line /@ Select[randomcoords, cutsGridQ]}, GridLines -> {Range[0, 10], None}]


Update 2: A function that takes two lists,l1 and l2, of lines and produces the points of intersection of each line in l1 with the lines in l2:

lineIntersections[l1_, l2_]:=Module[{tuples = Outer[List, l1, l2]},
DeleteCases[RegionIntersection @@@ # & /@ tuples, _EmptyRegion, 2]]


SeedRandom[1]
point[v_, u_] := Normalize[v - u] + u
vlines = Table[{RGBColor[0, 0, 0], Line[{{x, 0}, {x, 10}}]}, {x, 0, 10}];
randomlines = Table[{RGBColor[0.66, 0.38, 0.91],
u = {RandomReal[{0.5, 9.5}], RandomReal[{0.5, 9.5}]};
v = {RandomReal[{-100, 100}], RandomReal[{-100, 100}]};
Line[{point[v, u], u}]}, {50}];


Get the Line primitives from the two lists above:

vlinesprims = Cases[vlines, _Line, {0, Infinity}];
rlinesprims = Cases[randomlines, _Line, {0, Infinity}];


Using RegionIntersection find the intersections of each vertical line with each of the random lines:

intersections = Table[DeleteCases[RegionIntersection[v, #]& /@ rlinesprims, _EmptyRegion],
{v, vlinesprims}]


Display:

Graphics[{vlines, randomlines, PointSize[Large],
Transpose[{ColorData[97, "ColorList"][[;; Length@intersections ]], intersections}]}]


Update: For Version 9, you can use GraphicsMeshFindIntersections as follows:

GraphicsMeshMeshInit[]
intersections = Join @@@ (Table[GraphicsMeshFindIntersections[Graphics[{v, #}]] & /@
rlinesprims, {v, vlinesprims}] /. {} -> Sequence[] /. {} -> Sequence[]);

Graphics[{vlines, randomlines, PointSize[Large],
Transpose[{ColorData[1, "ColorList"][[;; Length@intersections]], Point/@intersections}]}]


Here's a method that sidesteps fancy region functionality. We exploit your choice of using vertical grid lines at integer positions to make a simplified test for filtering out intersecting "needles":

pt[v_, u_] := Normalize[v - u] + u

hitGridQ[Line[{p1_, p2_}]] :=
With[{min = Min[p1[[1]], p2[[1]]], max = Max[p1[[1]], p2[[1]]]},
min <= Round[min + (max - min)/2] <= max]

n = 100;
BlockRandom[SeedRandom[42, Method -> "MersenneTwister"]; (* for reproducibility *)
p1 = Graphics[{Directive[Purple, AbsoluteThickness[1/4]],
segs = Table[With[{u = RandomReal[{0.5, 9.5}, 2],
v = RandomReal[{-100, 100}, 2]},
Line[{pt[v, u], u}]], {n}]},
GridLines -> {Range[0, 10], None},
GridLinesStyle -> AbsoluteThickness[1]]]


Show[p1, Graphics[{Directive[Red, AbsoluteThickness[1/4]],
hits = Cases[segs, _?hitGridQ]}]]


The $\pi$ estimate:

N[2 Length[segs]/Length[hits]]
3.125


Still a long way off, but you do need to raise the value of n for something reasonable. Here, for instance, is what I get with n = 1000:

There's an example of exactly this in the documentation of RegionDisjoint. I'll copy it here.

Estimate $\pi$ by simulating Buffon's needle problem:

d = 0.2; n = 1000;

lines = MeshRegion[
Join @@ Table[{{-1 - d, y}, {1 + d, y}}, {y, -1 - d, 1 + d, d}],
Line[Partition[Range[2 Floor[2/d + 3]], 2]]
];


Create randomly orientated line segments of length $d$:

needles = Table[
Line[{pt, RandomPoint[Circle[pt, d]]}],
{pt, RandomReal[{-1, 1}, {n, 2}]}
];


Select line segments that overlap the grid of lines:

overlap = Select[needles, !RegionDisjoint[lines, #] &];


Visualize overlapping line segments (red):

Show[lines, Graphics[{Red, overlap, Black, Complement[needles, overlap]}]]


Estimation of $\pi$:

N[2n/Length[overlap]]

3.14465