# Nonlinear system of equations

I have been working to find an equilibrium solution for a Hamiltonian dynamical system. I have reduced the problem to the simultaneous solution of 3 equations:

1/(4 Sin[x]) - (a Sin[x])/(Sqrt[1 + a^2 + 2 a Cos[x]])^3 == 0

r^3 - 3/a^3 + (2 (a + Cos[x]))/(Sqrt[1 + a^2 + 2 a Cos[x]])^3 == 0

r^3 - 3 + (1 + a Cos[x])/(Sqrt[1 + a^2 + 2 a Cos[x]])^3 + 1/(4 Sin[x]) == 0


The conditions on the variables: $r>0,\,a>0,\,x\in[0,\pi]$. Can anyone see a way to simplify this even further? Mathematica brute force style on my lowsy pc just sits there. Is there an effective way to analyze this system with Mathematica? For a more complete discussion of this problem: https://math.stackexchange.com/questions/794747/3-equations-and-3-unkowns

What did you do to solve the system? FindRoot gets it in a flash.

ee = {1/(4 Sin[x]) - (a Sin[x])/(Sqrt[1 + a^2 + 2 a Cos[x]])^3,
r^3 - 3/a^3 + (2 (a + Cos[x]))/(Sqrt[1 + a^2 + 2 a Cos[x]])^3,
r^3 - 3 + (1 + a Cos[x])/(Sqrt[1 + a^2 + 2 a Cos[x]])^3 +
1/(4 Sin[x])};

FindRoot[Thread[ee == 0], {a, .2}, {r, .1}, {x, .2}]

(* Out= {a -> 0.993025829884, r -> 1.34271562194, x -> 1.34767597129} *)


It happens that this is the only solution but that's a different computation.

--- edit ---

For completeness, here is a way to show there are no other solutions that fit the requirements. We change the trigs to algebraic variables, add the identity that links them, and use NSolve.

ee = {1/(4 Sin[x]) - (a Sin[x])/(Sqrt[1 + a^2 + 2 a Cos[x]])^3,
r^3 - 3/a^3 + (2 (a + Cos[x]))/(Sqrt[1 + a^2 + 2 a Cos[x]])^3,
r^3 - 3 + (1 + a Cos[x])/(Sqrt[1 + a^2 + 2 a Cos[x]])^3 +
1/(4 Sin[x])};
ee2 = Join[
ee /. {Sin[x] -> sx, Cos[x] -> cx, Csc[x] -> 1/sx}, {sx^2 + cx^2 -
1}];

Timing[ns2 = NSolve[ee2];]

(* Out= {5.868000, Null} *)


Grab real solutions.

realsols = Select[Chop[ns2], FreeQ[#, Complex] &]

(* Out= {{sx -> 0.975211745463, cx -> 0.221273702709,
r -> 1.34271562194, a -> 0.993025829884}, {sx -> -0.971947823998,
cx -> 0.235196571882, r -> 1.42839757385, a -> 0.94316720469}} *)


Keep the ones that have a and r positive and also a positive angular value. We get that last from the two-argument arctan, with the cos value first and sine second.

Select[
Map[{#[], #[], ArcTan[#[], #[]]} &, {a, r, cx, sx} /.
realsols], And @@ Thread[# > 0] &]

(* Out= {{0.993025829884, 1.34271562194, 1.34767597129}} *)


--- end edit ---

• I tried Solve, NSolve, Reduce – JEM May 14 '14 at 18:14