1
$\begingroup$

Say I have an expression like $a(x)+b(x)\sqrt{c(x)}+d(x)\sqrt{e(x)}+f(x)g(\sin(x))$, where a(x) to f(x) mean polynomials of $x, g(x)$ is a polynomial of $sin(x)$. I wonder how to extract the different terms, e.g., $b(x), c(x), a(x), f(x)$?

If the above expression is too complex, how about the simplified version $a(x)+b(x)\sqrt{c(x)}$? This is what I am primarily concerned about.

The reason I'm concerned with this is that I'd like to get rid of the square root to get a polynomial, to solve the equation. I tried using the eliminate command as suggested by example using Eliminate, but somehow it returns very large coefficients like around $10^{260}$ for all the coefficients.

-1.52537-2.54462 Cos[\[Delta]]^3+Cos[\[Delta]]^2 (2.94197 -1.35683 Sin[\[Delta]])+2.44869 Sin[\[Delta]]-0.853005 Sin[\[Delta]]^2+Cos[\[Delta]] (4.69792 -2.41511 Sin[\[Delta]]-0.180872 Sin[\[Delta]]^2)+Sqrt[1/25-(0.102901 -0.19724 Cos[\[Delta]]-0.0525858 Sin[\[Delta]])^2] (3.77625 -6.10864 Cos[\[Delta]]^2+0.16943 Sin[\[Delta]]-4.70718 Sin[\[Delta]]^2+Cos[\[Delta]] (-15.4993+5.25663 Sin[\[Delta]]))

Could someone help, on how to extract the terms or how to solve a polynomial with one or potentially two square roots?

Thanks a lot!

$\endgroup$
  • $\begingroup$ Both Solve[yourexpression == 0, delta] and Reduce[yourexpression == 0, delta], which I assume is what you mean by "solving the polynomial", return reasonable results in almost no time. Wouldn't that be sufficient to solve the equation? $\endgroup$ – MarcoB Dec 4 '19 at 18:53
  • $\begingroup$ Thanks for the comment. Yes, I can get the numerical solution successfully, but what I'd like to get is an expression, perferably without square roots, to be used in a paper. As a result, I prefer to get rid of the square root first, after which I may use half-tangent identities to tranform the trig polynomial into a polynomial. $\endgroup$ – larry Dec 4 '19 at 19:01
  • $\begingroup$ besides, from my understanding, it seems that a polynomial is preferable to a trig polynomial, because (from my knowledge) it is easier to find all the roots of a polynomial than a trig polynomial. For the current problem, the trig polynomial will be 6 degree, which, when converted to polynomial using half identity, becomes degree of 12. I wonder which way is suggested, if one has to implement the numerical algorithm by themselves (without Mathematica, etc.)? Moreover, would square root cause much more burden in this process? $\endgroup$ – larry Dec 4 '19 at 19:08
1
$\begingroup$

I'm not sure this is what is sought but it might give some ideas.

ee = -1.52537 - 2.54462 Cos[\[Delta]]^3 + 
   Cos[\[Delta]]^2 (2.94197 - 1.35683 Sin[\[Delta]]) + 
   2.44869 Sin[\[Delta]] - 0.853005 Sin[\[Delta]]^2 + 
   Cos[\[Delta]] (4.69792 - 2.41511 Sin[\[Delta]] - 
      0.180872 Sin[\[Delta]]^2) + 
   Sqrt[1/25 - (0.102901 - 0.19724 Cos[\[Delta]] - 
         0.0525858 Sin[\[Delta]])^2] (3.77625 - 
      6.10864 Cos[\[Delta]]^2 + 0.16943 Sin[\[Delta]] - 
      4.70718 Sin[\[Delta]]^2 + 
      Cos[\[Delta]] (-15.4993 + 5.25663 Sin[\[Delta]]));
gb = 
 Expand[N[First[GroebnerBasis[Rationalize[Rationalize[ee], 0]]]]/10^23]

(* Out[51]= 4.76836353514 - 28.6703276402 Cos[\[Delta]] + 
 31.7329485231 Cos[\[Delta]]^2 + 43.5081178499 Cos[\[Delta]]^3 - 
 41.2169708643 Cos[\[Delta]]^4 - 22.8008864264 Cos[\[Delta]]^5 + 
 19.8169955299 Cos[\[Delta]]^6 - 19.1556952231 Sin[\[Delta]] + 
 77.1822425435 Cos[\[Delta]] Sin[\[Delta]] - 
 12.9216330024 Cos[\[Delta]]^2 Sin[\[Delta]] - 
 68.7910291343 Cos[\[Delta]]^3 Sin[\[Delta]] + 
 10.0472952743 Cos[\[Delta]]^4 Sin[\[Delta]] + 
 12.952125884 Cos[\[Delta]]^5 Sin[\[Delta]] + 
 24.171807059 Sin[\[Delta]]^2 - 
 57.15657135 Cos[\[Delta]] Sin[\[Delta]]^2 - 
 35.9372128245 Cos[\[Delta]]^2 Sin[\[Delta]]^2 + 
 24.7902022477 Cos[\[Delta]]^3 Sin[\[Delta]]^2 + 
 12.1118854195 Cos[\[Delta]]^4 Sin[\[Delta]]^2 - 
 9.35651606565 Sin[\[Delta]]^3 + 
 6.28655294722 Cos[\[Delta]] Sin[\[Delta]]^3 + 
 17.0532282882 Cos[\[Delta]]^2 Sin[\[Delta]]^3 + 
 0.385377612365 Cos[\[Delta]]^3 Sin[\[Delta]]^3 - 
 0.0125817869548 Sin[\[Delta]]^4 + 
 0.800114640976 Cos[\[Delta]] Sin[\[Delta]]^4 + 
 0.258959299084 Cos[\[Delta]]^2 Sin[\[Delta]]^4 - 
 0.610513917166 Sin[\[Delta]]^5 + 
 0.806975356565 Cos[\[Delta]] Sin[\[Delta]]^5 + 
 0.153178774605 Sin[\[Delta]]^6 *)
$\endgroup$
  • $\begingroup$ thanks for your comment, but it seems that you encountered the same problem that I experienced, namely, some very large coefficient arises, similar to when I used the Eliminate command. Thus, I feel not so confident about the accuracy of the coefficients, even if we have divided them by, say, 10^23. Is there anyway to avoid having such large coefficient? $\endgroup$ – larry Dec 5 '19 at 13:16
  • $\begingroup$ @larry Using arbitrary-precision miraculously keeps the coefficients small: gb = Expand[ First[GroebnerBasis[N[Rationalize[Rationalize[ee], 0], 32]]]], but the precision loss is signficant: Precision[gb] - 32. Might want to use N[..., 36] to get machine-precision accurate results. $\endgroup$ – Michael E2 Dec 5 '19 at 13:42
  • $\begingroup$ I rationalized them to the extent the input precision allows.So any issue involving numeric stability is going to be intrinsic to the problem formulation and conditioning The method used for solving it is not really the issue here. $\endgroup$ – Daniel Lichtblau Dec 6 '19 at 7:25
  • $\begingroup$ @MichaelE2,thanks for your comment, you have helped me solve problems many times! $\endgroup$ – larry Dec 6 '19 at 14:43
  • $\begingroup$ @DanielLichtblau, thanks for your comment, this offers an alternative and automatic way to handle the problem. $\endgroup$ – larry Dec 6 '19 at 14:44
1
$\begingroup$

On the simple example, something like this does the work:

CoefficientList[expr, DeleteDuplicates@Cases[expr, Power[_, 1/2], Infinity]]

On the more complicated ones, a better example would be needed for me to test how to extend the above idea.

OP's example:

sqrts = DeleteDuplicates@Cases[expr, Power[_, 1/2], Infinity]
(*  {Sqrt[1/25 - (0.102901 - 0.19724 Cos[δ] - 0.0525858 Sin[δ])^2]}  *)

{a, b} = CoefficientList[expr, sqrts];

a
(*
-1.52537 + 4.69792 Cos[δ] + 2.94197 Cos[δ]^2 - 
 2.54462 Cos[δ]^3 + 2.44869 Sin[δ] - 2.41511 Cos[δ] Sin[δ] - 
 1.35683 Cos[δ]^2 Sin[δ] - 0.853005 Sin[δ]^2 - 0.180872 Cos[δ] Sin[δ]^2
*)

b
(*
3.77625 - 15.4993 Cos[δ] - 6.10864 Cos[δ]^2 + 
 0.16943 Sin[δ] + 5.25663 Cos[δ] Sin[δ] -  4.70718 Sin[δ]^2
*)

Check:

FromDigits[{b, a}, First@sqrts] - expr // Simplify
(*  0.  *)

Extension to multiple square roots:

expr2 = a + {b}.sqrts + 2 a Sqrt[6.10864 Cos[δ]^2 + 0.16943 Sin[δ]];

sqrts2 = DeleteDuplicates@Cases[expr2, Power[_, 1/2], Infinity]
(*
{Sqrt[1/25 - (0.102901 - 0.19724 Cos[δ] - 0.0525858 Sin[δ])^2],
 Sqrt[6.10864 Cos[δ]^2 + 0.16943 Sin[δ]]}
*)

c2 = CoefficientList[expr2, sqrts2];
basis = PadLeft[List /@ sqrts2, {Automatic, 2}, 1];

Fold[Dot, c2, Reverse@basis] - expr2 // Simplify
(*  0.  *)

Fold[Dot, Transpose@c2, basis] - expr2 // Simplify
(*  0.  *)

The FromDigits example for reconstructing the polynomial from the docs for CoefficientList needs an awkward tweak:

Fold[ReleaseHold@ FromDigits[Hold /@ Reverse@#1, #2] &, c2, sqrts2] - 
  expr2 // Simplify
(*  0.  *)
$\endgroup$
  • $\begingroup$ Thanks, this works perfectly for my problem, even though I don't understand how the last two lines about "Fold" works, but that's sufficient for me to use. Thanks again! $\endgroup$ – larry Dec 5 '19 at 13:31

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.