Reduce cannot solve my system of trigonometric equations

Question

I have been running code to solve the following equations for hours and hours, but there are still no solutions! I am new to Mathematica, so I am not really sure whether or not it is a good idea to use Reduce to solve trigonometric equations.

Also, I want a symbolic solution, NOT a numeric one.

The code is:

eq1 := (Sin[
   Subscript[θ, 1] - Subscript[θ, 
    3]] (-Sin[
       Subscript[θ, 2] - Subscript[θ, 7]] Subscript[
     a, 1] + Cos[
      Subscript[θ, 2] - Subscript[θ, 7]] Subscript[
     a, 2]) + 
 Sin[Subscript[θ, 1] - Subscript[θ, 
    2]] (Sin[
      Subscript[θ, 3] - Subscript[θ, 7]] Subscript[
     b, 1] + Cos[Subscript[θ, 
      7]] (-Cos[Subscript[θ, 3]] + 
       Sin[Subscript[θ, 3]]) Subscript[b, 2])) Subscript[l,
1] Subscript[l, 2] Subscript[l, 3];

eq2 := Sin[
Subscript[θ, 1] - Subscript[θ, 
 4]] (-Cos[
    Subscript[θ, 2] - Subscript[θ, 7]] Subscript[a, 
  2] + Sin[
   Subscript[θ, 2] - Subscript[θ, 7]] (Subscript[a, 
    1] - Subscript[b, 1]) + 
 Cos[Subscript[θ, 
   7]] (Cos[Subscript[θ, 2]] - 
    Sin[Subscript[θ, 2]]) Subscript[b, 2]) Subscript[l, 1]
Subscript[l, 2] Subscript[l, 4];

eq3 := 1/2 Cos[Subscript[θ, 1]] Sin[
Subscript[θ, 2] - Subscript[θ, 
 5]] (-2 Sin[
   Subscript[θ, 3] - Subscript[θ, 7]] Subscript[b, 
  1] + 2 Cos[Subscript[θ, 
   7]] (Cos[Subscript[θ, 3]] - 
    Sin[Subscript[θ, 3]]) Subscript[b, 2]) Subscript[l, 1]
Subscript[l, 2] Subscript[l, 3] Subscript[l, 5];

eq4 := -Sin[
 Subscript[θ, 1] - Subscript[θ, 
  4]] (-Cos[Subscript[θ, 6]] Sin[
   Subscript[θ, 2] - Subscript[θ, 7]] Subscript[a, 
  1] + Cos[Subscript[θ, 6]] Cos[
   Subscript[θ, 2] - Subscript[θ, 7]] Subscript[a, 
  2] + Cos[Subscript[θ, 
   2]] (Sin[
      Subscript[θ, 6] - Subscript[θ, 7]] Subscript[
     b, 1] + Cos[Subscript[θ, 
      7]] (-Cos[Subscript[θ, 6]] + 
       Sin[Subscript[θ, 6]]) Subscript[b, 2])) Subscript[l,
1] Subscript[l, 2] Subscript[l, 4] Subscript[l, 6];

eq5 := -Sin[Subscript[θ, 2] - Subscript[θ, 3]] Sin[
Subscript[θ, 1] - Subscript[θ, 4]] Subscript[l, 1]
Subscript[l, 2] Subscript[l, 3] Subscript[l, 4];

eq6 := Sin[Subscript[θ, 1] - Subscript[θ, 3]] Sin[
Subscript[θ, 2] - Subscript[θ, 5]] Subscript[l, 1]
Subscript[l, 2] Subscript[l, 3] Subscript[l, 5];

eq7 := -Sin[Subscript[θ, 1] - Subscript[θ, 2]] Sin[
Subscript[θ, 3] - Subscript[θ, 6]] Subscript[l, 1]
Subscript[l, 2] Subscript[l, 3] Subscript[l, 6];

sols := Reduce[{eq1 == 0, eq2 == 0, eq3 == 0, eq4 == 0, eq5 == 0, 
eq6 == 0, eq7 == 0}, {Subscript[θ, 1], Subscript[θ, 
2], Subscript[θ, 3], Subscript[θ, 4], 
Subscript[θ, 5], Subscript[θ, 6], 
Subscript[θ, 7]}];

Any help will be appreciated.

Answer 1

Probably well beyond what can be handled due to the complexity. I'd try changing to a polynomial formulation (replace the trigs with new variables after first using TrigExpand), add defining relations between "sine" and "cosine" variables, and see if a Groebner basis can be extracted. The code below shows how one might go about this. Amongst other things, it also removes factors that do not involve the variables of interest, as they (generically) do not vanish.

trigs = TrigExpand[{eq1 == 0, eq2 == 0, eq3 == 0, eq4 == 0, eq5 == 0, 
      eq6 == 0, eq7 == 0}[[All, 1]] /. Subscript[th_, n_] -> th[n]];
vars = Cases[Variables[trigs], Sin[_] | Cos[_]];
reprule = {Sin[a_] :> s[a], Cos[a_] :> c[a]};
newtrigs = trigs /. reprule;
newvars = vars /. reprule;
cosvars = Cases[newvars, c[_]];
extratrigs = Map[#^2 + s[#[[1]]]^2 - 1 &, cosvars];

flists = Map[FactorList, newtrigs];
keepflists = 
  Map[Select[#, ! FreeQ[#, Alternatives @@ newvars] &] &, 
    flists, {2}] /. {} -> Nothing;
trigpolys = Apply[Times, keepflists, {1}];
    allpolys = Join[trigpolys, extratrigs]

(* {{a[2] c[θ[2]] c[θ[3]] c[θ[7]] s[θ[1]] - 
   b[2] c[θ[2]] c[θ[3]] c[θ[7]] s[θ[1]] + 
   b[2] c[θ[1]] c[θ[3]] c[θ[7]] s[θ[2]] - 
   a[1] c[θ[3]] c[θ[7]] s[θ[1]] s[θ[2]] - 
   a[2] c[θ[1]] c[θ[2]] c[θ[7]] s[θ[3]] + 
   b[1] c[θ[2]] c[θ[7]] s[θ[1]] s[θ[3]] + 
   b[2] c[θ[2]] c[θ[7]] s[θ[1]] s[θ[3]] + 
   a[1] c[θ[1]] c[θ[7]] s[θ[2]] s[θ[3]] - 
   b[1] c[θ[1]] c[θ[7]] s[θ[2]] s[θ[3]] - 
   b[2] c[θ[1]] c[θ[7]] s[θ[2]] s[θ[3]] + 
   a[1] c[θ[2]] c[θ[3]] s[θ[1]] s[θ[7]] - 
   b[1] c[θ[2]] c[θ[3]] s[θ[1]] s[θ[7]] + 
   b[1] c[θ[1]] c[θ[3]] s[θ[2]] s[θ[7]] + 
   a[2] c[θ[3]] s[θ[1]] s[θ[2]] s[θ[7]] - 
   a[1] c[θ[1]] c[θ[2]] s[θ[3]] s[θ[7]] - 
   a[2] c[θ[1]] s[θ[2]] s[θ[3]] s[θ[
      7]]}, {(c[θ[4]] s[θ[1]] - 
     c[θ[1]] s[θ[4]]) (a[
       2] c[θ[2]] c[θ[7]] - 
     b[2] c[θ[2]] c[θ[7]] - 
     a[1] c[θ[7]] s[θ[2]] + 
     b[1] c[θ[7]] s[θ[2]] + 
     b[2] c[θ[7]] s[θ[2]] + 
     a[1] c[θ[2]] s[θ[7]] - 
     b[1] c[θ[2]] s[θ[7]] + 
     a[2] s[θ[2]] s[θ[7]])}, {c[θ[
     1]] (c[θ[5]] s[θ[2]] - 
     c[θ[2]] s[θ[5]]) (b[
       2] c[θ[3]] c[θ[7]] - 
     b[1] c[θ[7]] s[θ[3]] - 
     b[2] c[θ[7]] s[θ[3]] + 
     b[1] c[θ[3]] s[θ[7]])}, {(c[θ[
        4]] s[θ[1]] - 
     c[θ[1]] s[θ[4]]) (a[
       2] c[θ[2]] c[θ[6]] c[θ[7]] - 
     b[2] c[θ[2]] c[θ[6]] c[θ[7]] - 
     a[1] c[θ[6]] c[θ[7]] s[θ[2]] + 
     b[1] c[θ[2]] c[θ[7]] s[θ[6]] + 
     b[2] c[θ[2]] c[θ[7]] s[θ[6]] + 
     a[1] c[θ[2]] c[θ[6]] s[θ[7]] - 
     b[1] c[θ[2]] c[θ[6]] s[θ[7]] + 
     a[2] c[θ[6]] s[θ[2]] s[θ[
        7]])}, {(c[θ[3]] s[θ[2]] - 
     c[θ[2]] s[θ[3]]) (c[θ[4]] s[θ[1]] - 
     c[θ[1]] s[θ[4]])}, {(c[θ[3]] s[θ[
        1]] - c[θ[1]] s[θ[3]]) (c[θ[
        5]] s[θ[2]] - 
     c[θ[2]] s[θ[5]])}, {(c[θ[2]] s[θ[
        1]] - c[θ[1]] s[θ[2]]) (c[θ[
        6]] s[θ[3]] - c[θ[3]] s[θ[6]])}, -1 + 
  c[θ[1]]^2 + s[θ[1]]^2, -1 + c[θ[2]]^2 + 
  s[θ[2]]^2, -1 + c[θ[3]]^2 + s[θ[3]]^2, -1 + 
  c[θ[4]]^2 + s[θ[4]]^2, -1 + c[θ[5]]^2 + 
  s[θ[5]]^2, -1 + c[θ[6]]^2 + s[θ[6]]^2, -1 + 
  c[θ[7]]^2 + s[θ[7]]^2} *)

I have no idea whether this will run to completion, let alone how useful it will be if it does (the size could be way to big to use in further manipulations).

AbsoluteTiming[
 gb = GroebnerBasis[allpolys, newvars, 
    MonomialOrder -> DegreeReverseLexicographic, 
    CoefficientDomain -> RationalFunctions];]