1
$\begingroup$

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

$\endgroup$
0

1 Answer 1

5
$\begingroup$

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[104]= {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[389]= {5.868000, Null} *)

Grab real solutions.

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

(* Out[394]= {{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[{#[[1]], #[[2]], ArcTan[#[[3]], #[[4]]]} &, {a, r, cx, sx} /. 
   realsols], And @@ Thread[# > 0] &]

(* Out[397]= {{0.993025829884, 1.34271562194, 1.34767597129}} *)

--- end edit ---

$\endgroup$
1
  • $\begingroup$ I tried Solve, NSolve, Reduce $\endgroup$
    – JEM
    Commented May 14, 2014 at 18:14

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.