Manipulate expression produces error messages

Question

I need to create the following: given two points on the surface of a unit sphere and a third one (that can be varied through Manipulate), find the point on the sphere that minimises the sum of the arc distances and then visualise the result. My attempt is based on the following code:

Arc3D[{a_, b_, m_}, n_: 60, prim_: Line] := 
  Module[{α, lab, axis, aarc, tm, alpha}, 
   lab = m + Norm[a - m]*Normalize[b - m];
   axis = (a - m)\[Cross](b - m);
   aarc = (VectorAngle[a - m, b - m]);
   tm = RotationMatrix[alpha, axis];
   prim @ Table[m + tm.(a - m), {alpha, 0, aarc, aarc/n}]];

or = {0, 0, 0};
u1 = 0;
f1 = 0;
u2 = Pi/3;
f2 = 0;
q = {Sin[u1] Cos[f1], Sin[u1] Sin[f1], Cos[u1]};
w = {Sin[u2] Cos[f2], Sin[u2] Sin[f2], Cos[u2]};
e := {Sin[u3] Cos[f3], Sin[u3] Sin[f3], Cos[u3]};
min := 
  NMinimize[
    {ArcCos[Cos[u1] Cos[ux] + Sin[u1] Sin[ux] Cos[f1 - fx]] + 
     ArcCos[Cos[u2] Cos[ux] + Sin[u2] Sin[ux] Cos[f2 - fx]] + 
     ArcCos[Cos[u3] Cos[ux] + Sin[u3] Sin[ux] Cos[f3 - fx]], 
     ux >= 0, ux <= Pi, fx >= 0, fx < 2 Pi}, {ux, fx}];
Ux := min[[2, 1, 2]];
Fx := min[[2, 2, 2]];
S := {Sin[Ux] Cos[Fx], Sin[Ux] Sin[Fx], Cos[Ux]};

followed by

Manipulate[
  Show[
    Graphics3D[
      {{Opacity[0.3], Sphere[{0, 0, 0}]}, 
       {Blue, Arc3D[{q, w, or}, 20]}, 
       {Blue, Arc3D[{w, e, or}, 20]}, 
       {Blue, Arc3D[{e, q, or}, 20]}, 
       {Green, Arc3D[{e, S, or}, 20]}, 
       {Green, Arc3D[{q, S, or}, 20]}, 
       {Green, Arc3D[{w, S, or}, 20]}, 
       Arrow[{{0, 0, 0}, q}],
       Arrow[{{0, 0, 0}, w}], 
       Arrow[{{0, 0, 0}, e}], 
       {Red, Arrow[{{0, 0, 0}, S}]}}], 
    Boxed -> False], 
  {{u3, Pi/2}, 0, Pi}, 
  {{f3, Pi/2}, 0, 2 Pi}]

which however returns a ton of errors. The code works if I remove the Manipulate command and I specify the coordinates for the third points, i.e. $e$, by giving explicit values to the angles $ux$ and $fx$. Thus, although the code is in principle working, it is the ``dynamic" part (user can change the $e$ point through manipulate) that fails.

Regarding the code, command Arc3D draws arcs between two points given their coordinates (ignore this part of the code as it is definitely working), min is the result of the numerical minimisation of the sum of the arc distances that are assigned to Ux and Fx and S are the cartesian coordinates of this ``minimal arc sum'' point.

All points are uniquely specified by the two angles $u,f$ but cartesian coordinates are also needed for drawing the arcs.

Can anyone find the error in my code and help me correct it?

An example of a working code ($e$ point specified in advance and no Manipulate command) returns the following graphic:

which is exactly what I want to do but with the addition of being able to dynamically change one of the points.

Answer 1

As a general comment I'd say that it is always best to avoid having so many global variables around, and even more avoid having implicit dependence on some other variable, like you have for your functions q, w, e ecc.

In fact, I modified your code localizing all the variables, and doing nothing more than that, and it turned out to work perfectly:

Arc3D[{a_, b_, m_}, n_: 60, prim_: Line] := 
  Module[{lab, axis, aarc, tm, alpha},
   lab = m + Norm[a - m]*Normalize[b - m];
   axis = (a - m)\[Cross](b - m);
   aarc = (VectorAngle[a - m, b - m]);
   tm = RotationMatrix[alpha, axis];
   prim@Table[m + tm.(a - m), {alpha, 0, aarc, aarc/n}]
   ];

q[u1_, f1_] := {Sin[u1] Cos[f1], Sin[u1] Sin[f1], Cos[u1]};
w[u2_, f2_] := {Sin[u2] Cos[f2], Sin[u2] Sin[f2], Cos[u2]};
e[u3_, f3_] := {Sin[u3] Cos[f3], Sin[u3] Sin[f3], Cos[u3]};
min[u1_, f1_, u2_, f2_, u3_, f3_] := NMinimize[
   {
    ArcCos[Cos[u1] Cos[ux] + Sin[u1] Sin[ux] Cos[f1 - fx]] +
     ArcCos[Cos[u2] Cos[ux] + Sin[u2] Sin[ux] Cos[f2 - fx]] +
     ArcCos[Cos[u3] Cos[ux] + Sin[u3] Sin[ux] Cos[f3 - fx]],
    ux >= 0, ux <= Pi, fx >= 0, fx < 2 Pi
    },
   {ux, fx}
   ];
Ux[u1_, f1_, u2_, f2_, u3_, f3_] := 
  min[u1, f1, u2, f2, u3, f3][[2, 1, 2]];
Fx[u1_, f1_, u2_, f2_, u3_, f3_] := 
  min[u1, f1, u2, f2, u3, f3][[2, 2, 2]];
S[u1_, f1_, u2_, f2_, u3_, f3_] := With[{
    ux = Ux[u1, f1, u2, f2, u3, f3],
    fx = Fx[u1, f1, u2, f2, u3, f3]
    },
   {Sin[ux] Cos[fx], Sin[ux] Sin[fx], Cos[ux]}
   ];

With[
 {u1 = 0, u2 = Pi/3, f1 = 0, f2 = 0, or = {0, 0, 0}},
 Manipulate[
  With[
   {q = q[u1, f1], w = w[u2, f2]},
   Module[{localS},
    localS[u3_, f3_] := S[u1, f1, u2, f2, u3, f3];
    Show[
     Graphics3D[{
       {Opacity[0.3], Sphere[{0, 0, 0}]},
       {Blue, Arc3D[{q, w, or}, 20]},
       {Blue, Arc3D[{w, e[u3, f3], or}, 20]},
       {Blue, Arc3D[{e[u3, f3], q, or}, 20]},
       {Green, Arc3D[{e[u3, f3], localS[u3, f3], or}, 20]},
       {Green, Arc3D[{q, localS[u3, f3], or}, 20]},
       {Green, Arc3D[{w, localS[u3, f3], or}, 20]},
       Arrow[{{0, 0, 0}, q}], Arrow[{{0, 0, 0}, w}], 
       Arrow[{{0, 0, 0}, e[u3, f3]}],

       {Red, Arrow[{{0, 0, 0}, localS[u3, f3]}]}
       }
      ],
     Boxed -> False
     ]
    ]
   ],
  {{u3, Pi/2}, 0, Pi}, {{f3, Pi/2}, 0, 2 Pi}
  ]
 ]

which produces the expected (I hope?) result: