How can I find least squares intersection of 3D rays?
EDIT: As @nikie noted, using FindArgMin
(a variant of FindMinimum
) instead of (N)ArgMin
can improve the speed of finding a solution. Since in the case of this problem only one minimum exists, this should actually produce the global minimum in an efficient manner.
How about this?
Module[{n, lines, sol},
n = 10;
lines = HalfLine[# + RandomPoint@Ball[], -2 # + RandomPoint@Ball[]] & /@
RandomPoint[Sphere[{0, 0, 0}, 10], n];
sol =
FindArgMin[Norm[RegionDistance[#, {x, y, z}] & /@ lines], {x, y, z}];
Graphics3D[{Arrow@Tube@{#1, #1 + #2} & @@@ lines,
Red, PointSize@Large, Point@sol}]]
Here lines
is a list of random almost-focused HalfLines
, sol
is the coordinate of least-squares solution, and rest is just visualizing the result (red Point
marks the spot).
This solution is constrained - by the fact HalfLine
s have a starting point, and that distances behind this point are measured to it, instead of the projection on the infinite line. This differs from solution provided by @J.M. which employs fully infinite lines. My solution can be turned into equivalent with that solution just by replacing HalfLine
with InfiniteLine
.
Here's another way to implement kirma's solution:
With[{n = 15}, BlockRandom[SeedRandom["many lines"]; (* for reproducibility *)
lines = HalfLine[# + RandomPoint @ Ball[], -2 # + RandomPoint @ Ball[]] & /@
RandomPoint[Sphere[{0, 0, 0}, 10], n]]];
sol = LeastSquares @@ Total[
With[{m = IdentityMatrix[3] - (Outer[Times, #, #] &[Normalize[#2]])},
{m, m.#1}] & @@@ lines];
Graphics3D[{{Gray, Arrow[Tube[{#1, #1 + #2} & @@@ lines]]},
{Directive[Red, PointSize[Large]], Point[sol]}}, Boxed -> False]