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)
Improve this question
$\endgroup$
2
  • $\begingroup$ Maybe this. $\endgroup$ 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$ Commented Oct 24, 2016 at 10:14

1 Answer 1

Reset to default
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]}

Improve this answer
$\endgroup$
24
  • $\begingroup$ You can use MemberQ instead of Not@FreeQ; and run Total in the last line to regain f. $\endgroup$ Commented Oct 24, 2016 at 10:54
  • $\begingroup$ @corey979 That was my first instinct too, but then you lose the special functions. $\endgroup$ Commented Oct 24, 2016 at 10:56
  • $\begingroup$ Yeah, I checked: MemberQ indeed doesn't work here. $\endgroup$ 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$ 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$ Commented Oct 24, 2016 at 23:37

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.