3
$\begingroup$

I have to solve the following system of equations:

Solve[{k*Sech[d]*Cos[b]/Sqrt[A^2 + B^2] == 1, 
k*Sech[d]*Sin[b]/Sqrt[A^2 + B^2] == 0, A*k*Tanh[d]/(A^2 + B^2)+c1 == 1,
B*k*Tanh[d]/(A^2 + B^2)+c2 == 0, k*Sech[k + d]*Cos[a + b]/Sqrt[A^2 + B^2] == 1, 
k*Sech[k + d]*Sin[a + b]/Sqrt[A^2 + B^2] == 0.1, 
A*k*Tanh[k + d]/(A^2 + B^2)+c1 == 1.1, 
B*k*Tanh[k + d]/(A^2 + B^2)+c2 == 0}, {k, d, a, b, A, B, c1, c2}]

but Solve will just compute forever and give no result. I've tried also with Reduce and NSolve, but with no luck. I can use approximated answers, so I've tried to use the Taylor series of the second order of the functions Sech Tanh Cos and Sin, but still Solve couldn't give me an answer.

I there something else I could try?

Thank you.

$\endgroup$
4
  • $\begingroup$ Where are c1 and c2 used in the equations? You can get rid of three of the divisions by A^2+B^2 where the right-hand side of the equation is zero. $\endgroup$
    – JimB
    Jan 2, 2017 at 23:10
  • $\begingroup$ I'm sorry, I didn't copy c1 and c2 in the equations, now they're correct $\endgroup$
    – User28341
    Jan 2, 2017 at 23:57
  • $\begingroup$ Are all the quantities real? $\endgroup$
    – bbgodfrey
    Jan 3, 2017 at 0:02
  • $\begingroup$ yes all quantities are real $\endgroup$
    – User28341
    Jan 3, 2017 at 8:55

2 Answers 2

3
$\begingroup$

Notice that most of your transcendal functions are neatly separated into pairs of equations.

This will get you most of the way to your solution

sys={k*Sech[d]*Cos[b]/Sqrt[A^2+B^2]==1, k*Sech[d]*Sin[b]/Sqrt[A^2+B^2]==0, 
  A*k*Tanh[d]/(A^2+B^2)+c1==1, B*k*Tanh[d]/(A^2+B^2)+c2==0, 
  k*Sech[k+d]*Cos[a+b]/Sqrt[A^2+B^2]==1, k*Sech[k+d]*Sin[a+b]/Sqrt[A^2+B^2]==1/10, 
  A*k*Tanh[k+d]/(A^2+B^2)+c1==11/10, B*k*Tanh[k+d]/(A^2+B^2)+c2==0};
sol=Eliminate[sys, {Sech[d], Tanh[d], Sech[k+d], Tanh[k+d]}]

which instantly tells you

(* B==0 && c2==0 && Cos[a+b]==10 Sin[a+b] && Sin[b]==0 && A!=0 *)

Follow that with

sys /. ToRules[sol] /. True -> Sequence[]

which instantly tells you

(* {(k Cos[b] Sech[d])/Sqrt[A^2] == 1,
    (10 k Sech[d+k] Sin[a+b])/Sqrt[A^2]==1,
       (k Sech[d+k] Sin[a+b])/Sqrt[A^2]==1/10,
     c1+(k Tanh[d])/A==1,
     c1+(k Tanh[d+k])/A==11/10}*)

Notice one of those equations is obviously redundant and can be eliminated. Then notice c1 can then be eliminated giving even one fewer equation. Then notice that information from the first step is telling you that b is a multiple of Pi and Cos[b] is either +1 or -1.

If you make use of all this information then you might be able to use Reduce to get to the final solution.

$\endgroup$
3
$\begingroup$

Define the set of equations as eq (with all numbers rationalized), and assume that all variables are real. Then,

eq /. k -> 0
(* {False, True, c1 == 1, c2 == 0, False, False, c1 == 11/10, c2 == 0} *)

So, k != 0.

Reduce[eq[[2]] && k != 0, b]
(* (k != 0 && A^2 + B^2 != 0 && Sech[d] == 0) || (C[1] ∈ Integers && 
    k != 0 && A^2 + B^2 != 0 && (b == 2 π C[1] || b == π + 2 π C[1])) *)

Since Sech[d] != 0 for real d, it follows that b is an integer multiple of π. Apply this result to obtain

eq1 = DeleteCases[Simplify[eq /. b -> n Pi, n ∈ Integers], True]
(* {((-1)^n k Sech[d])/Sqrt[A^2 + B^2] == 1, 
    c1 + (A k Tanh[d])/(A^2 + B^2) == 1, 
    c2 + (B k Tanh[d])/(A^2 + B^2) == 0, 
    (k Cos[a + n π] Sech[d + k])/Sqrt[A^2 + B^2] == 1, 
    (10 k Sech[d + k] Sin[a + n π])/Sqrt[A^2 + B^2] == 1, 
    c1 + (A k Tanh[d + k])/(A^2 + B^2) == 11/10, 
    c2 + (B k Tanh[d + k])/(A^2 + B^2) == 0} *)

Factor[First@eq1[[7]] - First@eq1[[3]]]
(* -((B k (Tanh[d] - Tanh[d + k]))/(A^2 + B^2)) *)

Hence, B == 0, and

eq1 /. B -> 0;
(* {((-1)^n k Sech[d])/Sqrt[A^2] == 1, 
    c1 + (k Tanh[d])/A == 1, 
    c2 == 0, 
    (k Cos[a + n π] Sech[d + k])/Sqrt[A^2] == 1, 
    (10 k Sech[d + k] Sin[a + n π])/Sqrt[A^2] == 1, 
    c1 + (k Tanh[d + k])/A == 11/10, 
    c2 == 0} *)

Hence, c2 == 0, and

eq2 = DeleteCases[% /. c2 -> 0, True]
(* {((-1)^n k Sech[d])/Sqrt[A^2] == 1, 
    c1 + (k Tanh[d])/A == 1, 
    (k Cos[a + n π] Sech[d + k])/Sqrt[A^2] == 1, 
    (10 k Sech[d + k] Sin[a + n π])/Sqrt[A^2] == 1, 
    c1 + (k Tanh[d + k])/A == 11/10} *)

This allows a to be calculated.

as = Simplify[Solve[First@eq2[[3]]/First@eq2[[4]] == 1, a][[1,1]]/.C[1] -> m, m ∈ Integers]
(* a -> m π - n π + ArcCot[10] *)
eq3 = Union[eq2 /. as]
(* {((-1)^n k Sech[d])/Sqrt[A^2] == 1, 
    (k Cos[m π + ArcCot[10]] Sech[d + k])/Sqrt[A^2] == 1, 
    (10 k Sech[d + k] Sin[m π + ArcCot[10]])/Sqrt[A^2] == 1, 
    c1 + (k Tanh[d])/A == 1, 
    c1 + (k Tanh[d + k])/A == 11/10} *)

Note that there now are more equations than variables, so one must be redundant. Now, assume that n and m are even integers.

Reduce[eq3 /. {m -> 0, n -> 0}, Reals] // Simplify
(* A == Log[19531250/(30100251 - 2278951 Sqrt[101])]/Sqrt[101] && 
   10 c1 == 11 && d == Log[1/10 (-1 + Sqrt[101])] && 
   10 k == Log[19531250/(30100251 - 2278951 Sqrt[101])] *)

along with the message,

Reduce::ztest1: Unable to decide whether numeric quantity ... is equal to zero. Assuming it is.

Unfortunately, it does not provide the complete expression that it assumes equal to zero, so we cannot evaluate it. Next, assume that n and m are odd integers.

Reduce[eq3 /. {m -> 1, n -> 1}, Reals] // Simplify
(* A == (-Log[2] - 10 Log[5] + Log[30100251 + 2278951 Sqrt[101]])/Sqrt[101] && 
   10 c1 == 11 && 
   d == Log[1/10 (1 + Sqrt[101])] && 
   10 k + Log[30100251 + 2278951 Sqrt[101]] == Log[2] + 10 Log[5] *)

Along with a similar message. On the other hand,

Reduce[eq3 /. {m -> 0, n -> 1}, Reals]
(* False *)
Reduce[eq3 /. {m -> 1, n -> 0}, Reals]
(* False *)

Finally, the question remains of whether the unknown expressions that Reduce assumes equal to zero actually are. To proceed, assume c2 == 11/10, as given in both tentative answers, and also that d == -k`, which also is given in the tentative answers, although not so obviously.

FullSimplify[Log[1/10 (-1 + Sqrt[101])] == 
             -Log[19531250/(30100251 - 2278951 Sqrt[101])]/10]
(* True *)

DeleteCases[Union[Simplify[eq3 /. c1 -> 11/10 /. d -> -k] /. {m -> 0, n -> 0}], True]
(* k == ArcCosh[Sqrt[101]/10] && 
   A == 100 Sqrt[1/101 (-1 + Sqrt[101]/10) (1 + Sqrt[101]/10)] ArcCosh[Sqrt[101]/10] *)

along with the same warning message, but this time with the assumed expression given.

Reduce::ztest1: Unable to decide whether numeric quantity ArcCosh[Sqrt[101]/10]+Log[2]+Log[5]-Log[1+Sqrt[101]] is equal to zero. Assuming it is.

Test it.

FullSimplify[ArcCosh[Sqrt[101]/10] + Log[2] + Log[5] - Log[1 + Sqrt[101]]]
(* 0 *)

Why Reduce did not do this is unclear. Likewise, for odd integers,

FullSimplify[Log[1/10 (1 + Sqrt[101])] == 
                 -(Log[2] + 10 Log[5] - Log[30100251 + 2278951 Sqrt[101]])/10]
(* True *)

DeleteCases[Union[Simplify[eq3 /. c1 -> 11/10 /. d -> -k] /. {m -> 1, n -> 1}], True]
(* {-((10 k)/(Sqrt[101] Sqrt[A^2])) == 1, 
   -((k Sech[k])/Sqrt[A^2]) == 1, 
   (10 k Tanh[k])/A == 1} *)
Reduce[%, {k, A}, Reals]
(* k == -ArcCosh[Sqrt[101]/10] && 
   A == 100 Sqrt[1/101 (-1 + Sqrt[101]/10) (1 + Sqrt[101]/10)] ArcCosh[Sqrt[101]/10] *)
FullSimplify[-ArcCosh[Sqrt[101]/10] + Log[2] + Log[5] - Log[-1 + Sqrt[101]]]
(* 0 *)

All unknowns now are evaluated. By the way, I attempted to use Reduce[eq, Reals] to obtain the complete solution directly, but it failed after several hours for lack of memory on my 16 GB PC.

$\endgroup$

Your Answer

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

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