# Minimization problem in proving Fermat's principle

I am trying to prove the Fermat's Principle of least distance, the problem statement goes:

Minimize[{n1* d1 * Sec[theta1] + n2 * d2 * Sec[theta2], d1 * Tan[theta1]+d2*Tan[theta2]==d},theta1]

I can't get a solution to this. The good solution should satisfyn1*Sin[theta1]=n2*Sin[theta2]

Can anyone help?

• Your constraint forces theta1 -> ConditionalExpression[ ArcTan[(d - d2 Tan[theta2])/ d1] + \[Pi] ConditionalExpression[1, \[Placeholder]], ConditionalExpression[1, \[Placeholder]] \[Element] Integers]
– JimB
Feb 13 at 6:11
• It is well explained how to proceed here: scipp.ucsc.edu/~haber/ph5B/fermat09.pdf Feb 13 at 16:09
• @DanielHuber: It is not so simple. There is a chance that a critical point is a point of maximum or a saddle point or is outside an interval. Feb 14 at 2:20
• To investigate what sort of critical point you have, you can use the Hessen matrix. Feb 14 at 9:42

As far as I understand it, you try to derive the law of retraction. Unfortunately, your notations are

not defined, so I'll use the notations from that Wiki article. Without loss of generality we may put $$c=1$$. We know the quantities $$a,b,l,n_1,n_2,$$ and $$x$$ is unknown. The optimization problem to derminate $$x$$ is formulated as follows.

ClearAll["Global*"];
Minimize[{n1*Sqrt[x^2 + a^2] + n2*Sqrt[b^2 + (l - x)^2],
n1 > 0 && n2 > 0 && l >= 0 && b > 0 && a > 0 && x <= l && x >= 0},  x]


Five parameters are too much for Minimize and the command is running without any response for hours. However, Mathematica does it for the specified parameters , e.g.

n1 = 1; n2 = 3/2; l = 2; b = 5; a = 1;
Minimize[{n1*Sqrt[x^2 + a^2] + n2*Sqrt[b^2 + (l - x)^2], n1 > 0 && n2 > 0 && l >= 0 && b > 0 &&
x <= l && x >= 0}, x] // AbsoluteTiming


{0.183459, {1/ 2 (2 Sqrt[ 1 + Root[36 - 36 # - 71 #^2 - 20 #^3 + 5 #^4& , 1, 0]^2] + 3 Sqrt[29 - 4 Root[36 - 36 # - 71 #^2 - 20 #^3 + 5 #^4& , 1, 0] + Root[36 - 36 # - 71 #^2 - 20 #^3 + 5 #^4& , 1, 0]^2]), {x -> Root[36 - 36 # - 71 #^2 - 20 #^3 + 5 #^4& , 1, 0]}}}.

Now we extract

x = x /. x -> Root[36 - 36 # - 71 #^2 - 20 #^3 + 5 #^4 &, 1, 0];


and express $$\sin \theta_1$$ and $$\sin \theta_2$$ through $$a,b,x,l$$ (see the linked Wiki article)

FullSimplify[x/Sqrt[x^2 + a^2]/(l - x)*Sqrt[(l - x)^2 + b^2]]


3/2.

I think Mathematica is able to crack the general case, but it requires a lot of time.

One could solve for critical points for the travel time T from one point to the other:

Block[{d, d1, n1, d2, n2},
SetAttributes[#, Constant] & /@ {d, d1, n1, d2, n2};
dT = Dt@{ (* differential of time + distance constraint *)
d1 n1 Sec[theta1] + d2 n2 Sec[theta2],
d1 Tan[theta1] + d2 Tan[theta2] - d}
]

(*
{d1 n1 Dt[theta1] Sec[theta1] Tan[theta1] +
d2 n2 Dt[theta2] Sec[theta2] Tan[theta2],
d1 Dt[theta1] Sec[theta1]^2 + d2 Dt[theta2] Sec[theta2]^2}
*)

jacT = CoefficientArrays[
dT, Dt@{theta1, theta2}
][];


The Solve form sol may be acceptable as is, but the OP showed an equation soleq for the expected solution:

sol = jacT //
Det //
Simplify //
Solve[# == 0, Sin@theta1, Reals] &

soleq = sol[[1, 1]] /. Rule -> Equal //
Simplify[#, n1 > 0] &

(*
{{Sin[theta1] -> (n2 Sin[theta2])/n1}}  <-- sol
n1 Sin[theta1] == n2 Sin[theta2]        <-- soleq
*)

• First, a good code is a commented code. Second, your solution is somewhat formal: d1 = -2; Block[{d, n1, d2, n2}, SetAttributes[#, Constant] & /@ {d, n1, d2, n2}; dT = Dt@{(*differential of time+distance constraint*) d1 n1 Sec[theta1] + d2 n2 Sec[theta2], d1 Tan[theta1] + d2 Tan[theta2] - d}];jacT = CoefficientArrays[dT, Dt@{theta1, theta2}][];sol = jacT // Det // Simplify // Solve[# == 0, Sin@theta1, Reals] produces {}[2 d2 Sec[theta1] Sec[ theta2] (-n1 Sec[theta2] Tan[theta1] + n2 Sec[theta1] Tan[theta2])] . Maybe {} indicates that is impossible? Feb 13 at 16:24
• If we put d1=2` in the above, the result is the same. Feb 13 at 16:29
• All that is not so simple. There is a chance that a critical point is a point of maximum or a saddle point or is outside an interval. Feb 14 at 2:21