Equation not getting solution

Questions
, ,
1

I am new to Mathematica and would appreciate some help. I had created a system of two simultaneous equations to try and solve a refraction problem using fermat’s principle of least time. Mathematica did not provide a solution after 2 days of computation. I have now manually performed substitution such that the equation is not simultaneous. Everything else is known apart from variable a2. Mathematica has not been able to provide a solution after a day and I suspect I have done something wrong. Any advice is appreciated

expr1 = a2 c1 Sqrt[x1/(a2^2 (c2^2 - c1^2) + c2^2 x2)]
expr2 = a2 c3 Sqrt[x3/(a2^2 (c2^2 - c3^2) + c2^2 x2)]
Solve[expr1 + expr2 == b - a2, a2]
2

Hi

If you assign numerical values to the 7 parameters

x1, x2, x3, b, c1, c2, c3

then you get a result very quickly.

I just tried that with

{x1, x2, x3, b, c1, c2, c3} = RandomReal[{-3, 3}, 7]

(x1 a real number in the range {-3,3}, x2 a real number in the same range, etc.

It looks like a too complicated transcendental equation for a2, so as I see it you have to work with numerical parameters, not symbolic parameters.

3

I think you have no chance to find a symbolic solution. In the end you arrive at an equation of 12th order for a2:

expr1 = a2 c1 Sqrt[x1/(a2^2 (c2^2 - c1^2) + c2^2 x2)]
expr2 = a2 c3 Sqrt[x3/(a2^2 (c2^2 - c3^2) + c2^2 x2)]

eq0 = expr1 + expr2 == b - a2

eq1 = Expand[#^2 & /@ eq0]

eq2 = (# - eq1[[1, 1 ;; 2]]) & /@ eq1

eq3 = Expand[#^2 & /@ eq2]

eq4 = Together /@ eq3

dnm1 = Denominator[eq4[[1]]]
dnm2 = Denominator[eq4[[2]]]

lhs = eq4[[1]] dnm2
rhs = eq4[[2]] dnm2

eq5 = Collect[lhs - rhs, a2]

The final equation is eq5 == 0.
This gives several solutions, most of them complex numbers, but also often several real ones.
But not each of the reals is identical to the solution found using the original equation:

{x1, x2, x3, b, c1, c2, c3} = RandomReal[{0, 3}, 7]
NSolve[expr1 + expr2 == b - a2, a2]
NSolve[eq5 == 0, a2]
Select[%, Element[#[[1, 2]], Reals] &]