System of nonlinear equations

Question

I am new at mathematica, and I am trying to solve the following system of four equations (f11==0 ,f12==0 , f13==0 , f14==0) under mathematica 10 , they depend on the real variables "alpha, beta, R and r " (with r and R POSITIVE). It takes too much time to evaluate the solutions, and I guess because they are non linear equations. I don't really know where to start.

f11 = (1/8)*r*((-(-2 + R^2))*(-2*h + r^2 + R^2)*Sin[2*α] - 
     R^2*(2 - 2*h + r^2 + R^2)*Sin[2*β]), 
  f12 = (1/8)*(4*h*(-2 + R^2) - 2*(R^4 + 2*r^2*(-2 + R^2)) + 
     (2*h - 2*r^2 - R^2)*((-2 + R^2)*Cos[2*α] + 
       2*R^2*Cos[α]*Cos[α - 2*β]) + 
     2*R^2*(2 + Cos[2*(α - β)]) - 2*R^2*Cos[2*β]), 
  f13 = (1/8)*R*((-(-2 + r^2))*(-2*h + r^2 + R^2)*
      Sin[2*(α - β)] + r^2*(2 - 2*h + r^2 + R^2)*Sin[2*β]), 
  f14 = (1/8)*((2 + r^2 - R^2)*(-2*h + r^2 + R^2)*Cos[2*α] + 
     (-2 + r^2 - R^2)*(-2*h + r^2 + R^2)*Cos[2*(α - β)] + 
     (r^2 - R^2)*(2 - 2*h + r^2 + R^2)*(2 + Cos[2*β]))

EDIT: according to "J.M."I used the Weirstrass substitution so I did the following but it still doesn't work

Quit
{f11 = (1/8)*r*((-(-2 + R^2))*(-2*h + r^2 + R^2)*Sin[2*\[Alpha]] - 
 R^2*(2 - 2*h + r^2 + R^2)*Sin[2*\[Beta]]), 
  f12 = (1/8)*(4*h*(-2 + R^2) - 2*(R^4 + 2*r^2*(-2 + R^2)) + 
 (2*h - 2*r^2 - R^2)*((-2 + R^2)*Cos[2*\[Alpha]] + 
   2*R^2*Cos[\[Alpha]]*Cos[\[Alpha] - 2*\[Beta]]) + 
 2*R^2*(2 + Cos[2*(\[Alpha] - \[Beta])]) - 2*R^2*Cos[2*\[Beta]]), 
  f13 = (1/8)*R*((-(-2 + r^2))*(-2*h + r^2 + R^2)*
  Sin[2*(\[Alpha] - \[Beta])] + r^2*(2 - 2*h + r^2 + R^2)*Sin[2*\[Beta]]), 
  f14 = (1/8)*((2 + r^2 - R^2)*(-2*h + r^2 + R^2)*Cos[2*\[Alpha]] + 
 (-2 + r^2 - R^2)*(-2*h + r^2 + R^2)*Cos[2*(\[Alpha] - \[Beta])] + 
 (r^2 - R^2)*(2 - 2*h + r^2 + R^2)*(2 + Cos[2*\[Beta]]))}

J=FullSimplify[{{D[f11,r],D[f11,R],D[f11,\[Alpha]],D[f11,\[Beta]]},{D[f12,r],D[f12,R],D[f12,\[Alpha]],D[f12,\[Beta]]},{D[f13,r],D[f13,R],D[f13,\[Alpha]],D[f13,\[Beta]]},{D[f14,r],D[f14,R],D[f14,\[Alpha]],D[f14,\[Beta]]}}]
aa=Solve[f11==0,r]
bb=FullSimplify[{f12,f13,f14}/.{r->Sqrt[4 h Sin[2 \[Alpha]]-2 R^2 Sin[2 \[Alpha]]-2 h R^2 Sin[2 \[Alpha]]+R^4 Sin[2 \[Alpha]]+2 R^2 Sin[2 \[Beta]]-2 h R^2 Sin[2 \[Beta]]+R^4 Sin[2 \[Beta]]]/Sqrt[2 Sin[2 \[Alpha]]-R^2 Sin[2 \[Alpha]]-R^2 Sin[2 \[Beta]]]}]
cc=Numerator[Factor[TrigExpand[bb]/.Sin[\[Alpha]] -> s/.Sin[\[Beta]]-> S/.Cos[\[Alpha]]->c/.Cos[\[Beta]]->C]]
e1=Factor[cc[[1]]]
e2=Factor[cc[[2]]]
e3=Factor[cc[[3]]]
e4=s^2+c^2-1;
e5=S^2+C^2-1;
GroebnerBasis[{e1,e2,e3,e4,e5},{R,s,c,S,C}]
xx=Factor[%]
d1=Factor[Resultant[e1,e2,R]]

d2=Factor[Resultant[e1,e3,R]]
d4=e4;
d5=e5;
GroebnerBasis[{d1,d2,d4,d5},{s,c,S,C}]

Answer 1

One way to go about this is to expand out the trigs, substitute "algebraic" variables such as sxxx for Sin[xxx] etc., add the algebraic relations needed to enforce the trig identities e.g. cxxx^2+sxxx^2-1. I show this below.

exprs = {(1/8) r ((-(-2 + R^2))*(-2*h + r^2 + R^2) Sin[2 alf] - 
      R^2*(2 - 2*h + r^2 + R^2) Sin[2 bet]), (1/8)*(4*h*(-2 + R^2) - 
      2*(R^4 + 2*r^2*(-2 + R^2)) + (2*h - 2*r^2 - 
         R^2)*((-2 + R^2) Cos[2 alf] + 
         2*R^2*Cos[alf] Cos[alf - 2 bet]) + 
      2*R^2*(2 + Cos[2*(alf - bet)]) - 2*R^2*Cos[2*bet]), (1/
      8) R ((-(-2 + r^2))*(-2*h + r^2 + R^2)*Sin[2*(alf - bet)] + 
      r^2*(2 - 2*h + r^2 + R^2) Sin[2 bet]), (1/
      8) ((2 + r^2 - R^2) (-2*h + r^2 + R^2) Cos[
        2 alf] + (-2 + r^2 - R^2)*(-2*h + r^2 + R^2) Cos[
        2 (alf - bet)] + (r^2 - R^2)*(2 - 2*h + r^2 + R^2) (2 + 
         Cos[2 bet]))};
exprs2 = TrigExpand[exprs];
reps = {Cos[alf] -> ca, Sin[alf] -> sa, Cos[bet] -> cb, 
   Sin[bet] -> sb};
exprs3 = Join[exprs2 /. reps, {ca^2 + sa^2 - 1, cb^2 + sb^2 - 1}];

I will not show the system we get, but suffice it to say that it isn't small.

What are our variables?

Variables[exprs3]

(* Out[123]= {ca, cb, h, r, R, sa, sb} *)

One variable too many for NSolve. We'll solve for a special case where we have assigned it the (totally random) value of 2.

Timing[
 solns = NSolve[exprs3 /. h -> 2, Method -> "EndomorphismMatrix"];]

(* Out[125]= {2165.149701, Null} *)

How many are there?

solns // Length

(* Out[126]= 656 *)

Okay, lets see about real solutions.

realsolns = Select[solns, FreeQ[#, Complex] &];
Length[realsolns]

(* Out[128]= 160 *)

Now obtain just the ones in range (I could have combined this step with the one above).

wantedsolns = Select[realsolns, (r /. #) > 0 && (R /. #) > 0 &];
Length[wantedsolns]

(* Out[132]= 40 *)

We'll show a few of these.

wantedsolns[[1 ;; 5]]

(* Out[133]= {{ca -> -1., cb -> 0., r -> 1.76723106175, 
  R -> 2.44948974278, sa -> 0., sb -> -1.}, {ca -> 0., cb -> 0., 
  r -> 2.44948974278, R -> 1.76723106175, sa -> -1., 
  sb -> 1.}, {ca -> -0.597756103331, cb -> -0.285375281861, 
  r -> 2.56334753081, R -> 2.56334753081, sa -> 0.801678015746, 
  sb -> -0.958415853637}, {ca -> -1., cb -> 1., r -> 1.09544511501, 
  R -> 1.26491106407, sa -> 0., sb -> 0.}, {ca -> 0.597756103331, 
  cb -> 0.285375281861, r -> 2.56334753081, R -> 2.56334753081, 
  sa -> -0.801678015746, sb -> 0.958415853637}} *)

From here one can find alf and bet using standard 2-arg ArcTan.