Message Boards Message Boards

NSolve and FindRoot unable to solve system of trig equations

I am trying to find numerical solutions for this system of trig equations:

a = -1/3; 

R[\[Alpha]_,\[Beta]_,\[Gamma]_] = {{1, 0, 0}, {0, Cos[\[Alpha]], -Sin[\[Alpha]]},{0, Sin[\[Alpha]],Cos[\[Alpha]]}}. {{Cos[\[Beta]],0,Sin[\[Beta]]},{0,1, 0},{-Sin[\[Beta]],0,Cos[\[Beta]]}} . {{Cos[\[Gamma]], -Sin[\[Gamma]],0},{Sin[\[Gamma]],Cos[\[Gamma]],0},{0,0,1}};

a1 = {1, -1, 1}/Sqrt[3];
a2 = {1, 1, -1}/Sqrt[3];

b1 = R[10 * Degree, 45*Degree, 20*Degree].a1;
b2 =R[10 * Degree, 45*Degree, 20*Degree].a2;

A1 = R[10 * Degree, 20 * Degree, 30* Degree].a1;
A2 = R[10 * Degree, 20 * Degree, 30* Degree].a2;

B1 = R[10 * Degree, 20 * Degree, 30* Degree].b1;
B2 = R[10 * Degree, 20 * Degree, 30* Degree].b2;

phia1 = N[ArcCos[a1.{0, 0, 1}]];
phia2 = N[ArcCos[a2.{0, 0, 1}]];
phib1 = N[ArcCos[b1.{0, 0, 1}]];
phib2 =N[ArcCos[b2.{0, 0, 1}]];
phiA1 =N[ArcCos[A1.{0, 0, 1}]];
phiA2 = N[ArcCos[A2.{0, 0, 1}]];
phiB1 = N[ArcCos[B1.{0, 0, 1}]];
phiB2 = N[ArcCos[B2.{0, 0, 1}]];

sol = NSolve[
Cos[alpha1 - alpha2] == (a - Cos[phia1]*Cos[phia2])/(Sin[phia1]*Sin[phia2]) &&
Cos[beta1 - beta2] == (a - Cos[phib1]*Cos[phib2])/(Sin[phib1]*Sin[phib2])&&
Cos[gamma1 - gamma2] == (a - Cos[phiA1]*Cos[phiA2])/(Sin[phiA1]*Sin[phiA2])&&
Cos[delta1 - delta2] ==(a - Cos[phiB1]*Cos[phiB2])/(Sin[phiB1]*Sin[phiB2])&& 

Sin[phia1] * Sin[phib1] * Cos[alpha1 - beta1] + Cos[phia1]*Cos[phib1] == Sin[phiA1]*Sin[phiB1]*Cos[gamma1 - delta1] + Cos[phiA1]*Cos[phiB1] &&
Sin[phia1]*Sin[phib2]*Cos[alpha1 - beta2] + Cos[phia1]*Cos[phib2] == Sin[phiA1]*Sin[phiB2]*Cos[gamma1 - delta2] + Cos[phiA1]*Cos[phiB2] &&
Sin[phia2] * Sin[phib1]*Cos[alpha2 - beta1] + Cos[phia2]*Cos[phib1] == Sin[phiA2]*Sin[phiB1]*Cos[gamma2 - delta1] + Cos[phiA2]*Cos[phiB1] &&
Sin[phia2]*Sin[phib2]*Cos[alpha2 - beta2] + Cos[phia2]*Cos[phib2] == Sin[phiA2]*Sin[phiB2]*Cos[gamma2 - delta2] + Cos[phiA2]*Cos[phiB2] &&

0 <= alpha1 <= 2*Pi && 0 <= alpha2 <= 2*Pi && 0 <= beta1 <= 2*Pi && 0 <= beta2 <= 2*Pi && 0<= gamma1 <=2*Pi && 0<=gamma2<=2*Pi && 0<=delta1<=2*Pi && 0<=delta2<=2*Pi,
{alpha1, alpha2, beta1, beta2, gamma1, gamma2, delta1, delta2}, Reals]

This system should definitely have a solution, but for some reason NSolve does not return anything after 10-15 minutes of running the notebook. I also tried using FindRoot and choosing initial guesses near the actual values for alpha1 = ArcCos[a1.{1, 0, 0}], alpha2 = ArcCos[a2.{1, 0, 0}], etc:

alpha1guess = N[ArcCos[a1.{1, 0, 0}]] + 0.5;
alpha2guess = N[ArcCos[a2.{1, 0, 0}]] + 0.5;
beta1guess = N[ArcCos[b1.{1, 0, 0}]] + 0.5;
beta2guess = N[ArcCos[b2.{1, 0, 0}]] + 0.5;
gamma1guess = N[ArcCos[A1.{1, 0, 0}]] + 0.5;
gamma2guess = N[ArcCos[A2.{1, 0, 0}]] + 0.5;
delta1guess = N[ArcCos[B1.{1, 0, 0}]] + 0.5;
delta2guess = N[ArcCos[B2.{1, 0, 0}]] + 0.5;

sol = FindRoot[
{Cos[alpha1 - alpha2] == (a - Cos[phia1]*Cos[phia2])/(Sin[phia1]*Sin[phia2]),
Cos[beta1 - beta2] == (a - Cos[phib1]*Cos[phib2])/(Sin[phib1]*Sin[phib2]),
Cos[gamma1 - gamma2] == (a - Cos[phiA1]*Cos[phiA2])/(Sin[phiA1]*Sin[phiA2]),
Cos[delta1 - delta2] ==(a - Cos[phiB1]*Cos[phiB2])/(Sin[phiB1]*Sin[phiB2]), 
Sin[phia1] * Sin[phib1] * Cos[alpha1 - beta1] + Cos[phia1]*Cos[phib1] == Sin[phiA1]*Sin[phiB1]*Cos[gamma1 - delta1] + Cos[phiA1]*Cos[phiB1],
Sin[phia1]*Sin[phib2]*Cos[alpha1 - beta2] + Cos[phia1]*Cos[phib2] == Sin[phiA1]*Sin[phiB2]*Cos[gamma1 - delta2] + Cos[phiA1]*Cos[phiB2],
Sin[phia2] * Sin[phib1]*Cos[alpha2 - beta1] + Cos[phia2]*Cos[phib1] == Sin[phiA2]*Sin[phiB1]*Cos[gamma2 - delta1] + Cos[phiA2]*Cos[phiB1],
Sin[phia2]*Sin[phib2]*Cos[alpha2 - beta2] + Cos[phia2]*Cos[phib2] == Sin[phiA2]*Sin[phiB2]*Cos[gamma2 - delta2] + Cos[phiA2]*Cos[phiB2]},
{{alpha1, alpha1guess},{ alpha2, alpha2guess}, {beta1, beta1guess}, {beta2, beta2guess}, {gamma1, gamma1guess}, {gamma2, gamma2guess}, {delta1, delta1guess}, {delta2, delta2guess}}]

However, whichever values I choose for the initial guesses, FindRoot returns this error: FindRoot::jsing: Encountered a singular Jacobian at the point {alpha1,alpha2,beta1,beta2,gamma1,gamma2,delta1,delta2} = {1.05532,1.05532,0.472267,1.83579,0.452311,1.66968,0.656504,2.45326}. Try perturbing the initial point(s).

What is the issue here? Are there any other ways to solve this system numerically with Mathematica?

POSTED BY: Alice Wang
2 Replies

You have 8 variables that appear in 12 combinations:

vars = {alpha1, alpha2, beta1, beta2, gamma1, gamma2, delta1, 
   delta2};
combs = {alpha1 - alpha2, beta1 - beta2, gamma1 - gamma2, 
   delta1 - delta2, alpha1 - beta1, gamma1 - delta1, alpha1 - beta2, 
   gamma1 - delta2, alpha2 - beta1, gamma2 - delta1, alpha2 - beta2, 
   gamma2 - delta2};

Actually, the combinations are not independent: all of them can be written in terms of the first six of them:

replaceWithC = Solve[combs[[;; 6]] == Array[c, 6], vars[[2 ;; 7]]][[1]]
combs /. replaceWithC

Your 8 equations can be rewritten in terms of 6 unknowns:

eqsWithC = N[eqs] /. replaceWithC // Chop // Rationalize

Your equations are either redundant or incompatible, and this may help explain why NSolve has trouble with them. The first four equations can be solved independently of the others:

sol4 = NSolve[eqsWithC[[;; 4]] && -2 Pi <= c[1] <= 2 Pi &&
    -2 Pi <= c[2] <= 2 Pi && -2 Pi <= c[3] <= 2 Pi &&
    -2 Pi <= c[4] <= 2 Pi] // Union

You can then solve the next two and see what happens with the last ones:

sol6 = eqsWithC[[5 ;; 6]] /. sol4[[1]] // Solve
eqsWithC[[7 ;;]] /. sol4[[3]] /. sol6
POSTED BY: Gianluca Gorni
Posted 16 days ago

NMinimize[{SumOfSquaresOfDifferencesOfLeftAndRightSideOfYourSystem,YourConstraints},YourVariables]

returns almost instantly with

{5.46948*^-20,{alpha1->0.633271,alpha2->2.20407,beta1->1.08791,beta2->3.18211,
 gamma1->0.425981,gamma2->2.26128,delta1->1.00128,delta2->3.06042}}

and with no warning or error messages.

The left and right hand side of your first equation appear to be slightly different. That seems to be because both those are likely going to zero and NMinimize thinks it is finished before it really pounds both of those down to zero. The rest of the equations appear to not be going to zero and thus the left and right hand sides appear close to identical. You can look at the documentation for NMinimize if you want it to work harder.

POSTED BY: Bill Nelson
Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
Attachments
Remove
or Discard

Group Abstract Group Abstract