Find intersection of pairs of straight lines
p1 = Partition[{{243.8, 77.}, {467.4, 12.}, {291.8, 130.}, {476.,
210.5}, {103.2, 327.}, {245.2, 110.5}, {47.4, 343.}, {87.4,
108.5}, {371., 506.5}, {384.6, 277.}, {264.6, 525.5}, {353.8,
294.5}, {113.2, 484.5}, {296., 304.5}, {459.6, 604.5}, {320.2,
466.5}, {288.2, 630.5}, {199.6, 446.5}, {138.8, 615.5}, {81.8,
410.}, {232.4, 795.}, {461.8, 727.}, {27.4, 671.5}, {206.8,
763.5}}, 2];
p2 = Partition[{{356.8, 32.}, {363.2, 120.}, {346., 245.}, {393.8,
158.}, {163.8, 211.5}, {230.2, 250.}, {54.6, 225.}, {139.6,
220.}, {366., 394.5}, {451.8, 372.}, {241., 398.}, {321.,
411.5}, {163.2, 347.}, {213.2, 406.5}, {332.4, 596.5}, {402.4,
528.5}, {176., 585.5}, {256., 530.5}, {38.2, 553.}, {122.4,
507.}, {345.2, 774.5}, {345.2, 688.}, {104.6, 728.}, {161.8,
647.}}, 2];
LineIntersectionPoint[{a_, b_}, {c_, d_}] :=
(Det[{a, b}] (c - d) - Det[{c, d}] (a - b))/Det[{a - b, c - d}]
Graphics[{Line /@ {p1, p2}, Red, [email protected],
Point /@ MapThread[LineIntersectionPoint, {p1, p2}]}, Frame -> True]
Ref for finding intersection of 2 lines by determinants
Turning my comment into an answer per (now deleted?) comment which requested it.
This is documented to work only in Wolfram Language at this point (specifically Wolfram Programming Cloud). Interestingly enough, it does work also with Mathematica 9.0.1., although documentation has no indication of Line
or Solve
supporting geometric regions.
p1 = {{243.8, 77.}, {467.4, 12.}, {291.8, 130.}, {476.,
210.5}, {103.2, 327.}, {245.2, 110.5}, {47.4, 343.}, {87.4,
108.5}, {371., 506.5}, {384.6, 277.}, {264.6, 525.5}, {353.8,
294.5}, {113.2, 484.5}, {296., 304.5}, {459.6, 604.5}, {320.2,
466.5}, {288.2, 630.5}, {199.6, 446.5}, {138.8, 615.5}, {81.8,
410.}, {232.4, 795.}, {461.8, 727.}, {27.4, 671.5}, {206.8,
763.5}};
p2 = {{356.8, 32.}, {363.2, 120.}, {346., 245.}, {393.8,
158.}, {163.8, 211.5}, {230.2, 250.}, {54.6, 225.}, {139.6,
220.}, {366., 394.5}, {451.8, 372.}, {241., 398.}, {321.,
411.5}, {163.2, 347.}, {213.2, 406.5}, {332.4, 596.5}, {402.4,
528.5}, {176., 585.5}, {256., 530.5}, {38.2, 553.}, {122.4,
507.}, {345.2, 774.5}, {345.2, 688.}, {104.6, 728.}, {161.8,
647.}};
(* Convert coordinate-lists to two collections of lines which can be used as
primitives in both in graphics and new geometric computation. *)
{lines1, lines2} = Line[Partition[#, 2]]& /@ {p1, p2};
(* Create points which belong to both geometric regions
consisting of line collections, that is any intersections. *)
points = Point[{x, y}] /. Solve[{x, y} \[Element] lines1 &&
{x, y} \[Element] lines2, {x, y}];
(* Represent all these as Graphics. *)
Graphics[{Blue, lines1, Red, lines2,
Black, PointSize[Large], points}, Frame->True]
EDIT:
You can also write above Solve
in v10 as:
Solve[{x, y} \[Element] RegionIntersection[lines1, lines2], {x, y}]
This gets interesting when you consider the fact these regions can be much more than lines, for instance circles, filled regions such as disks, implicit and parametric regions, and derived regions. Also in higher dimensions, and symbolically. And they can be discretized, among other things for use of FEM in v10.
Here is a direct vector calculation that verifies the segments (not just the infinite lines) intersect.
segsegintersection[ lines_ ] := Module[{
md = Subtract @@ (Plus @@ # & /@ lines),
sub = Subtract @@ # & /@ lines, det},
det = -Det[sub];
If[And @@ (Abs[#] <= 1 & /@ #) ,
(Plus @@ #[[1]] - Subtract @@ #[[1]] Last@#[[2]])/2 & @
{First@lines, # }, False] &@
(Det[{#[[1]], md}]/det & /@ ( {#, Reverse@#} &@ sub))];
in the example provided they all intersect.. but I thought it useful to included here for completeness. This is way faster than using Solve
with constraints. Note @eldo's LineIntersectionPoint
is faster than this by a factor of 2 if you do not need the intersection check.
Graphics[ {Line /@ p1 , Line /@ p2 , Red, PointSize[.025],
Point@ MapThread[segsegintersection[{ #1 , #2 }] & , {p1, p2} ]}]
same plot as the others..
An example with only some intersections:
lines = RandomReal[{-1, 1}, {20, 2, 2}];
Graphics[{Line@lines, Red, PointSize[.02],
Point@Select[ segsegintersection[#] & /@
Subsets[lines, {2}] , # =!= False &]}]