Line-Line Intersection

Author

Eric W. Weisstein
December 8, 2004

This notebook downloaded from http://mathworld.wolfram.com/notebooks/PlaneGeometry/Line-LineIntersection.nb.

For more information, see Eric's MathWorld entry http://mathworld.wolfram.com/Line-LineIntersection.html.

©2005 Wolfram Research, Inc. except for portions noted otherwise

Initialization

2-D

soln=Solve[{
Det[{{x,y,1},{x1,y1,1},{x2,y2,1}}]==0,
Det[{{x,y,1},{x3,y3,1},{x4,y4,1}}]==0},
{x,y}][[1]]//FullSimplify

Simplify[
{Det[{{Det[{{x1,y1},{x2,y2}}],x1-x2},{Det[{{x3,y3},{x4,y4}}],x3-x4}}]/Det[{{x1-x2,y1-y2},{x3-x4,y3-y4}}]-x,
Det[{{Det[{{x1,y1},{x2,y2}}],y1-y2},{Det[{{x3,y3},{x4,y4}}],y3-y4}}]/Det[{{x1-x2,y1-y2},{x3-x4,y3-y4}}]-y
}/.soln]

xvec={x,y};
v[i_]:={x[i],y[i]};
eqns=And@@LogicalExpand/@{xvec==v[1]+(v[2]-v[1])s,xvec==v[3]+(v[4]-v[3])t}

FullSimplify[Expand[Solve[eqns,{x,y},{s,t}][[1]]]]/.{x[n_]:>Subscript[x,n],y[n_]:>Subscript[y,n]}//TraditionalForm

line1=Line[{{0,0},{1,.3}}];
line2=Line[{{0,.3},{.9,.1}}];
Show[Graphics[{
line1,
line2,
{
Red,
PointSize[.03],
Intersections[line1,line2]
}
}],AspectRatio->Automatic,PlotRange->All]

Intersections[Line[{{0,0},{1,0}}],Line[{{0,1},{1,1}}]]

Trilinears

FullSimplify[Solve[{l1 α+m1 β+n1 γ==0,l2 α+m2 β+n2 γ==0,γ==1},{α,β,γ}]]

{-m2 n1+m1 n2,l2 n1-l1 n2,-l2 m1+l1 m2}

Det/@{{{m1,m2},{n1,n2}},{{n1,n2},{l1,l2}},{{l1,l2},{m1,m2}}}

Det/@Partition[RotateLeft[Transpose[{{l1,m1,n1},{l2,m2,n2}}]],2,1,1]

Cross@@@{{{a1,b1,c1},{a2,b2,c2}},{{a3,b3,c3},{a4,b4,c4}}}

Intersections[tri__]:=Det/@Partition[RotateLeft[Transpose[Cross@@@{tri}]],2,1,1]/;Dimensions[{tri}]=={2,2,3}

Intersections[{{a1,b1,c1},{a2,b2,c2}},{{a3,b3,c3},{a4,b4,c4}}]

FullSimplify[(a+b-c)c Intersections@@Take[Transpose[{IdentityMatrix[3],TrilinearVertexMatrix[ContactTriangle]}],2]]

Trilinears[GergonnePoint]

Factor[Solve[{l α+m β+n γ==0,TrilinearLine[{{a1,b1,c1},{a2,b2,c2}}]==0,γ==1},{α,β,γ}]]

Collect[{a2 b1 m+a1 b2 m-a2 c1 n+a1 c2 n,a2 b1 l-a1 b2 l-b2 c1 n+b1 c2 n,a2 c1 l-a1 c2 l+b2 c1 m-b1 c2 m},{l,m,n}]

3-D

4-point cross-product

<<Platonic`

FaceIntersections[poly_]:=Module[{pairs=KSubsets[Take[#,3]&/@First/@poly,2]},
DeleteCases[Intersection3D@@@Map[Plane,pairs,{2}],{}]
]

poly=Cube;
Show[Graphics3D[{Polyhedron[poly],{Red,lines=FaceIntersections[Polyhedron[poly]]},PointSize[.02],points=Intersection3D@@@KSubsets[lines,2]}]]

4-point equations

xvec={x,y,z};
v[i_]:={x[i],y[i],z[i]};
eqns=LogicalExpand[xvec==v[1]+(v[2]-v[1])s==v[3]+(v[4]-v[3])t]&&Det[Append[#,1]&/@Array[v,4]]==0

An example of intersecting lines

lines={x[1]->-1,y[1]->0,z[1]->0,x[2]->4,y[2]->0,z[2]->0,x[3]->-2,y[3]->-2,z[3]->-2,x[4]->3,y[4]->3,z[4]->3};

LinearSolve[{{x[2]-x[1],x[3]-x[4]},{y[2]-y[1],y[3]-y[4]},{z[2]-z[1],z[3]-z[4]}}/.lines,-{x[1]+x[3],y[1]+y[3],z[1]+z[3]}/.lines]

Intersection3D[Line[{{-1,0,0},{4,0,0}}],Line[{{-2,-2,-2},{3,3,3}}]]

Intersection3D[Line[{{-1,0,0},{4,1,0}}],Line[{{-2,-2,-2},{3,3,3}}]]

Direct solution

NSolve[eqns/.lines,{x,y,z},{s,t}]

Solve[eqns/.lines,{x,y,z},{s,t}]

Analytic solution

soln=FullSimplify[Eliminate[eqns,{t,x,y,z}]]

The last condition is simply that the four points be coplanar

Expand[Subtract@@Last[soln]-Det[Append[#,1]&/@Array[v,4]]]

Here are the other solutions

ss=FullSimplify[Flatten[List@@(Solve[#,s]&/@Drop[soln,-1])]]

Plugging these back in gives one singular solution

v[1]+(v[2]-v[1])s/.#&/@ss/.lines

In general, there are three solutions, which are either identical or singular

v[1]+(v[2]-v[1])s/.#&/@ss

Simplify[Together[v[1]+(v[2]-v[1])s/.#]]&/@ss/.{x[n_]:>Subscript[x,n],y[n_]:>Subscript[y,n],z[n_]:>Subscript[z,n]}

Attempting to solve completely without first eliminating variables gives a huge mess

soln=Solve[eqns,{x,y,z},{s,t}];

LeafCount[soln]

soln2=Simplify[soln];

LeafCount[soln2]

Timing[LeafCount[soln3=FullSimplify[soln2]]]

soln2/.lines

Compact solution

Intersections[Line[{p1_,q1_}],Line[{p2_,q2_}]]:=Module[
{
v1=#/Sqrt[#.#]&[q1-p1],
v2=#/Sqrt[#.#]&[q2-p2],
v12,s1,s2
},
v12=Cross[v1,v2];
s1=Det[{p2-p1,v2,v12}]/v12.v12;
s2=Det[{p2-p1,v1,v12}]/v12.v12;
(p1+p2+v1 s1+v2 s2)/2
] /; Union[Length/@{p1,q1,p2,q2}]=={3}

Intersections[Line[{{-1,0,0},{4,0,0}}],Line[{{-2,-2,-2},{3,3,3}}]]

Solve[{-1,0,0}+r{4,0,0}=={-2,-2,-2}+s{3,3,3},{r,s}]

{{-1,0,0}+r{4,0,0},{-2,-2,-2}+s{3,3,3}}/.%

{#1+(#2-#1)r&@@{{-1,0,0},{4,0,0}},
#1+(#2-#1)s&@@{{-2,-2,-2},{3,3,3}}}

Solve[{-1+5 r,0,0}=={-2+5 s,-2+5 s,-2+5 s},{r,s}]

{{-1+5 r,0,0},{-2+5 s,-2+5 s,-2+5 s}}/.%

Trilinears

<<PlaneGeometry`

Trilinears

k[α_,β_,γ_]:=2Δ/(a α+b β+c γ)
x[α_,β_,γ_]:=((k[α,β,γ]β-r+(k[α,β,γ]α-r)Cos[C])/(Sin[C]))
y[α_,β_,γ_]:=k[α,β,γ]α-r
rr[α_,β_,γ_]:={x[α,β,γ],y[α,β,γ]}

p=FullSimplify[Coordinates[Intersections@@(Line/@Partition[rr@@@Transpose[Array[#,4]&/@{α,β,γ}],2])]]

s=FullSimplify[Solve[{x==((k[α,β,γ]β-r+(k[α,β,γ]α-r)Cos[C])/(Sin[C])),y==k[α,β,γ]α-r},{α,β}]]

i=FullSimplify[s/. Thread[{x,y}->p]]

(d1=Expand[(α[2] (α[4] β[3] γ[1]-α[3] β[4] γ[1]-α[4] β[1] γ[3]+α[3] β[1] γ[4])+α[1] (-α[4] β[3] γ[2]+α[3] β[4] γ[2]+α[4] β[2] γ[3]-α[3] β[2] γ[4]))])/.f_[g_]:>Subscript[f,g]//TraditionalForm

Select[Permutations[Range[4]],

Det[Array[a,{4,4}]]

Det[{{α[1],α[1],β[1],γ[1]},{α[2],α[2],β[2],γ[2]},{α[3],α[3],β[3],γ[3]},{α[4],α[4],β[4],γ[4]}}]

FullSimplify[d1]

α(1) \[LeftBracketingBar]({{α(2), β(2), γ(2)}, {α(3), β(3), γ(3)}, {α(4), β(4), γ(4)}})\[RightBracketingBar]-α(2) \[LeftBracketingBar]({{α(1), β(1), γ(1)}, {α(3), β(3), γ(3)}, {α(4), β(4), γ(4)}})\[RightBracketingBar]

Simplify[d1+(α[2]Det[{{α[1],β[1],γ[1]},{α[3],β[3],γ[3]},{α[4],β[4],γ[4]}}]-α[1]Det[{{α[2],β[2],γ[2]},{α[3],β[3],γ[3]},{α[4],β[4],γ[4]}}])]

(d2=Expand[(α[4] β[3] (β[2] γ[1]-β[1] γ[2])+α[3] β[4] (-β[2] γ[1]+β[1] γ[2])-(α[2] β[1]-α[1] β[2]) (β[4] γ[3]-β[3] γ[4]))])/.f_[g_]:>Subscript[f,g]//TraditionalForm

Simplify[d2+(β[2]Det[{{α[1],β[1],γ[1]},{α[3],β[3],γ[3]},{α[4],β[4],γ[4]}}]-β[1]Det[{{α[2],β[2],γ[2]},{α[3],β[3],γ[3]},{α[4],β[4],γ[4]}}])]

Simplify[d1+(α[2]Det[{{α[1],β[1],γ[1]},{α[3],β[3],γ[3]},{α[4],β[4],γ[4]}}]-α[1]Det[{{α[2],β[2],γ[2]},{α[3],β[3],γ[3]},{α[4],β[4],γ[4]}}])]

(d3=Expand[((α[4] β[2] γ[1]-α[2] β[4] γ[1]-α[4] β[1] γ[2]+α[1] β[4] γ[2]) γ[3]-(α[3] β[2] γ[1]-α[2] β[3] γ[1]-α[3] β[1] γ[2]+α[1] β[3] γ[2]) γ[4])])/.f_[g_]:>Subscript[f,g]//TraditionalForm

Simplify[d3+(γ[2]Det[{{α[1],β[1],γ[1]},{α[3],β[3],γ[3]},{α[4],β[4],γ[4]}}]-γ[1]Det[{{α[2],β[2],γ[2]},{α[3],β[3],γ[3]},{α[4],β[4],γ[4]}}])]

Check

<<PlaneGeometry`

t=Triangle[{{0,0},{1,0},{.2,.30}}];

FullSimplify[Midpoint[{Centroid,Orthocenter}]]

Midpoint[t,{Centroid,Orthocenter}]

Midpoint[Line[Coordinates/@{Centroid[t],Orthocenter[t]}]]