Point and line segment intersection point. Both moving

Question

How would I tell the time and point of intersection between a moving Point at a fixed velocity and a Line Segment whose end-points are moving? The endpoints move independently, but only in the positive y direction, and also at fixed velocities.

Picture of situation:

So over time t, L1 moves to L2, R1 moves to R2 and P1 moves to P2. At some point the position of P at time t should lie somewhere on the line segment formed by L and R at time t.

I stuck every relationship I could come up with in mathematica and had it solve for t, which got me an answer, but it doesn't seem to work when I try and implement it (no collision is ever detected. I'm pretty new to mathematica and don't really know what I'm doing so I'm kind of hoping someone with more experience will notice something fundamentally wrong with how I'm trying to solve the system of equations. Thanks for reading!

Where U is the line segment at time t.

• Ly = L1y + (L2y - L1y) * t
• Ry = R1y + (R2y - R1y) * t
• Py = P1y + (P2y - P1y) * t
• Px = P1x + (P2x - P1x) * t
• Ux = L1x + (R1x - L1x) * m
• Uy = Ly + (Ry - Ly) * m
• m = (Px - L1x) / (R1x - L1x)

Solving for t where:

• Ux = Px
• Uy = Py

Solution:

• A = (P2x - P1x) * (L2y - L1y) - (P2x - P1x) * (R2y - R1y)
• B = (P2x - P1x) * L1y + (P2x - P1x) * R1y - P1x * (L2y - L1y) + L1x * (L2y - L1y) + P1x * (R2y - R1y) - L1x * (R2y - R1y) + (P2y - P1y) * (R1x - L1x) - (R1x - L1x) * (L2y - L1y)
• C = P1x * L1y - P1x * R1y - L1y * L1x + R1y * L1x + P1y * (R1x - L1x) - L1y * (R1x - L1x)

t = (-B + -sqrt(B^2 - 4AC)) / 2A

Answer 1

A numerical solution:

l1 = {0.969, 0.594};
l2 = {0.892, 0.895};
r1 = {0.75880, 0.90366};
r2 = {0.22, 0.57};
p = {0.337+ 0.8764 t, 0.726 + 0.252 t};
s1 = l1 + ( l2 - l1) t;
s2 =  r1 + (r2 - r1) t;
lx = ( (1 + ci) s1 + (1 - ci) s2 )/2 ;
ciz = (ci /. 
   Solve[ Dot[ {px, 
      py}  - ( (1 + ci) {s1x, s1y} + (1 - ci) {s2x, s2y} )/
      2 , {s1x, s1y} - {s2x, s2y}] == 0, ci][[1]]);
cizt = Simplify[
   ciz /. { px -> p[[1]] , py -> p[[2]] , 
     s1x -> (l1 + ( l2 - l1) t)[[1]], 
     s1y -> (l1 + ( l2 - l1) t)[[2]] , 
     s2x -> (r1 + ( r2 - r1) t)[[1]], 
     s2y -> (r1 + ( r2 - r1) t)[[2]] }];
distance[t_] = 
  Simplify[Norm[lx - p]^2  /. ci -> cizt ,  Assumptions -> {Im[t] == 0} ];
Plot[distance[t], {t, 0, 1}]
possiblesolution = FindMinimum[distance[t], {t, 0, 1}]
If[ Chop[possiblesolution[[1]]] == 0, 
 tp = (t /. possiblesolution[[2]]); Print["possible hit at t=", tp]; 
 If[Abs[cizt /. possiblesolution[[2]]] > 1, 
 Print["missed off the end"], 
 Animate[Show[Graphics[{Point[{p /. t -> 0, p /. t -> 1} ]}], 
Graphics[{Line[{l1, r1} ]}], Graphics[{Line[{l2, r2} ]}], 
Graphics[{Dashed, Line[{s1, s2} /. t -> a]}], 
If[a < tp, Graphics[{Red, Line[{p /. t -> 0, p /. t -> a}]}], 
 Graphics[{Red, Line[{p /. t -> 0, p /. t -> a}], Blue, 
   Line[{p /. t -> tp, p /. t -> a}]}]]], {a, 0, 1}]]]

If you look at the distance function you see the minimum is the root of a 7'th order polynomial..to be robust you need to look at all the real roots.

edit -- a better version based on Mr Wizard's solution. I've improved it a bit by checking that the intersection point is on the segment, not just on the infinte line between the points. This example generates random problems and stops after finding a problem with a valid solution.

solutions = {}
While[Length[solutions] == 0,
 {l1, l2, r1, r2, p1, p2} = RandomReal[{0, 1}, 2] &  /@ Range[6];
 p = p1 + (p2 - p1) t  ;
 s1 = l1 + ( l2 - l1) t;
 s2 =  r1 + (r2 - r1) t;
 realsols = 
  Solve[ { 0 < t < 1 ,  Det[ { s1 - s2 , p - s2}]  == 0 ,Dot[ p - s2  , p - s1 ] < 0 } ];
 If[Length[realsols] > 0, solutions = Sort[ (t /. realsols)]; 
  tp = solutions[[1]]];] 
Animate[Show[
  Graphics[{Point[{p1, p2} ]}],
  Graphics[{Green, Line[{l1, r1} ]}],
  Graphics[{Orange, Line[{l2, r2} ]}],
  Graphics[{Dashed, Line[{s1, s2} /. t -> a]}],
  If[a < tp,
   Graphics[{Red, Line[{p1, p /. t -> a}]}],
   Graphics[{
     Red, Line[{p1, p /. t -> a}],
     Blue, Line[{p /. t -> tp, p /. t -> a}]}
    ]]], {a, 0, 1}]

Incedentally it is much faster to let Solve[] find all the solutions then select off the valid ones rather than giving solve the constraints.

(Do [ realsols = 
    Solve[ { Det[ { s1 - s2 , p - s2}]  == 0 , 0 < t < 1, 
      Dot[ p - s2  , p - s1 ] < 0 } ] , {10} ]; realsols)  // Timing
(Do [realsols = 
    Select[ Solve[ {  Det[ { s1 - s2 , p - s2}]  == 0   , 
       0 < t < 1}  ] , 
     Dot[ p - s2  , p - s1 ] < 0 /. #  & ]   , {100} ]; 
  realsols) // Timing
(Do [realsols = 
    Select[ Solve[ {  Det[ { s1 - s2 , p - s2}]  == 0   } ] ,  0 <= t <= 1  &&    Dot[ p - s2  , p - s1 ]  < 0  /. #   & ]   , {100} ]; 
  realsols ) // Timing

the first form is prettier though :-)

Answer 2

Define points:

{L1, L2, R2, R1, P1, P2} =
   {{0.01`, 0.31`}, {0, 2.`}, {2.985`, 1.9`}, {2.995`, 0.95`},
    {1.7`, 1.82`}, {1.23`, 0.87`}};

Define functions:

L := L1 (1 - t) + L2 t
R := R1 (1 - t) + R2 t
P := P1 (1 - t) + P2 t

Visualize problem:

Manipulate[
 Block[{t = tt},
  Graphics[{
    {Red, Polygon[{L1, L2, R2, R1}]},
    {White, Thick, Line[{P1, P2}]},
    {Black, PointSize[Large], Point@{L, R, P}, Line[{L, R}]}
   }, Background -> Gray, PlotRangePadding -> 0.7]
 ],
 {tt, 0, 1}
]

Solve for t and observe that the solution matches the visualization:

Reduce[{Det[{R - L, P - L}] == 0, 0 < t < 1}, t]

t == 0.525873

Profit.