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}]]

enter image description here

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 HalfLines 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]

least-squares "intersection" point