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$
4
$\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$
  • $\begingroup$ I tried Solve, NSolve, Reduce $\endgroup$ – JEM May 14 '14 at 18:14

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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