3
$\begingroup$

Here is my issue. I am posting because I did not find a direct answer anywhere. I have a bunch of terms which I obtain by Expand[] of a product. The result contains terms like (a, b are const):

0.5 b x^2 Cos[a]^3 Cos[x^2/2] FresnelC[x/Sqrt[b]]

Sqrt[b] x Cos[a]^2 Cos[x^2/2]^2 FresnelC[x/Sqrt[b]] Sin[a]

0.5 Cos[a] Cos[x^2/2]^3 Sin[a]^2

Cos[a]^2 Sin[a] Sin[x^2/2]

and so on - you get the idea (hopefully). For each of these (and the rest - there are ~200 terms altogether) there are a few of them with different coefficients. I want to gather terms with identical x-dependence together, but Group[] only works for polynomials. Any help is appreciated.

Edit: My original product which I want to expand and group is as follows:

Exprpos[x_] = (-(1/2)*Cos[a]*Cos[x^2/2] + (1/2)*Sin[a]*
      Sin[x^2/2])*(Sqrt[b]*x*Cos[a]*FresnelC[x/Sqrt[b]] - (1/2)*
       Sqrt[b]*Cos[a]*x - 
      Sqrt[b]*Sin[a]*x*FresnelS[x/Sqrt[b]] + (1/2)*Sqrt[b]*Sin[a]*x - 
      Cos[a]*Sin[x^2/2] - Sin[a]*Cos[x^2/2] + Sin[a])^2 - (Cos[a]*
      Sin[x^2/2] + 
     Sin[a]*Cos[x^2/2])*((1/2)*b*Cos[a]*Cos[a]*FresnelC[x/Sqrt[b]]*
      FresnelC[x/Sqrt[b]] - (1/2)*b*Cos[a]*Cos[a]*
      FresnelC[x/Sqrt[b]] + (b/8)*Cos[a]*Cos[a] + (1/2)*b*Sin[a]*
      Sin[a]*FresnelS[x/Sqrt[b]]*FresnelS[x/Sqrt[b]] - (1/2)*b*Sin[a]*
      Sin[a]*FresnelS[x/Sqrt[b]] + (b/8)*Sin[a]*Sin[a] - 
     Sqrt[b]*Sin[a]*Sin[a]*x*FresnelC[x/Sqrt[b]] - 
     b*Sin[a]*
      Cos[a] (FresnelS[x/Sqrt[b]]*FresnelC[x/Sqrt[b]] - (1/2)*
         FresnelS[x/Sqrt[b]] - (1/2)*
         FresnelC[x/Sqrt[b]] + (1/4)) + (1/2)*Sqrt[b]*Sin[a]*Sin[a]*
      x - Sin[a]*Cos[2 a]*Cos[x^2/2] + Sin[a]*Sin[2 a]*Sin[x^2/2] + 
     Sin[a]*Cos[2 a] - 
     Sqrt[b]*Sin[a]*Cos[a]*x*FresnelS[x/Sqrt[b]] + (1/2)*Sqrt[b]*
      Sin[a]*Cos[a]*x + (1/2)*Cos[2*a] Sin[x^2] + (1/2)*
      Sin[2*a] Cos[x^2] - (1/2)*Sin[2*a] - 
     Sqrt[b/2]*Cos[2*a]*x*FresnelC[Sqrt[2/b] x] + (1/2)*Sqrt[b/2]*
      Cos[2 a]*x + 
     Sqrt[b/2]*Sin[2*a]*x*FresnelS[Sqrt[2/b] x] - (1/2)*Sqrt[b/2]*
      Sin[2 a]*x)
$\endgroup$
2
  • $\begingroup$ Maybe this. $\endgroup$
    – corey979
    Commented Oct 24, 2016 at 9:36
  • 1
    $\begingroup$ For future reference, you can format code by indenting a line with four spaces, wrapping code in grave accents, or highlighting code and selecting the {} button. $\endgroup$
    – Feyre
    Commented Oct 24, 2016 at 10:14

1 Answer 1

2
$\begingroup$

With thanks to JHM:

Suppose your list of terms is f:

f = 0.5 b x^2 Cos[a]^3 Cos[x^2/2] FresnelC[x/Sqrt[b]] + 
   3 c x^2 Cos[a]^3 Cos[x^2/2] FresnelC[x/Sqrt[b]] + 
   Sqrt[b] x Cos[a]^2 Cos[x^2/2]^2 FresnelC[x/Sqrt[b]] Sin[a] + 
   0.5 Cos[a] Sin[x^2/2] Sin[a]^2 + Cos[a]^2 Sin[a] Sin[x^2/2];

First run f=Expand[f], to be sure.

We can construct a function xterms which selects which subparts of the parts of the function contain x:

xterms[eq_] := Select[eq, Not[FreeQ[#, x]] &]
flistDD = Reverse@Sort@
  DeleteDuplicates@(flist = Table[xterms[f[[i]]], {i, Length[f]}])

{x^2 Cos[x^2/2] FresnelC[x/Sqrt[b]], x Cos[x^2/2]^2 FresnelC[x/Sqrt[b]], Sin[x^2/2]}

Now, we find their positions:

pos = Table[
DeleteDuplicates@Flatten[Position[flist, flistDD[[i]]]], {i, Length[flistDD]}]

{{1, 2}, {3}, {4, 5}}

Meaning we have dependence of (this code is not necessary, just a showcase):

Transpose[{flistDD, pos}]

{{x^2 Cos[x^2/2] FresnelC[x/Sqrt[b]], {1, 2}}, {x Cos[x^2/2]^2 FresnelC[x/Sqrt[b]], {3}}, {Sin[x^2/2], {4, 5}}}

Your gathering of terms is then finally given by:

Table[Part[f, pos[[i]]], {i, Length[flistDD]}] // Simplify

{(0.5 b + 3 c) x^2 Cos[a]^3 Cos[x^2/2] FresnelC[x/Sqrt[b]], Sqrt[b] x Cos[a]^2 Cos[x^2/2]^2 FresnelC[x/Sqrt[b]] Sin[a], Cos[a] (Cos[a] + 0.5 Sin[a]) Sin[a] Sin[x^2/2]}

If you want this as a function instead of a list add //Total.

ADDENDUM

Suppose one term encompasses another, and we get a pos of

{{1, 5}, {3, 4}, {1, 2, 3, 4, 5}}

As we have reverse ordered the list, we need to eliminate later duplicates.

Table[Table[
  pos[[i]] = Complement[pos[[i]], pos[[j]]], {j, i - 1}], {i, 
  Length[flistDD]}];
pos

{{1, 5}, {3, 4}, {2}}

And now we get:

Table[Part[f, pos[[i]]], {i, Length[flistDD]}] // Simplify

{-(1/4) b x^2 Cos[a]^2 Cos[x^2/2] (11 Cos[a] - Sin[a]), -(1/ 4) (-2 + Sqrt[2]) Sqrt[b] x Cos[a]^2 Cos[x^2/2] Sin[a], -(1/8) b Cos[a]^2 Cos[x^2/2] Sin[a]}

$\endgroup$
24
  • $\begingroup$ You can use MemberQ instead of Not@FreeQ; and run Total in the last line to regain f. $\endgroup$
    – corey979
    Commented Oct 24, 2016 at 10:54
  • $\begingroup$ @corey979 That was my first instinct too, but then you lose the special functions. $\endgroup$
    – Feyre
    Commented Oct 24, 2016 at 10:56
  • $\begingroup$ Yeah, I checked: MemberQ indeed doesn't work here. $\endgroup$
    – corey979
    Commented Oct 24, 2016 at 10:59
  • $\begingroup$ Great, many thanks. However, do I need to know all the functions which appear beforehand? Can I just instruct it to group the terms together, without me knowing which are which? $\endgroup$
    – Morgan
    Commented Oct 24, 2016 at 11:42
  • 1
    $\begingroup$ @corey979 Note the difference in the default level specs for MemberQ ({1}) and FreeQ ({1, Infinity}). (This is why your suggestion does not work as is.) $\endgroup$
    – Michael E2
    Commented Oct 24, 2016 at 23:37

Your Answer

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

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