Skip to main content
replaced http://mathematica.stackexchange.com/ with https://mathematica.stackexchange.com/
Source Link

With thanks to JHMJHM:

With thanks to JHM:

With thanks to JHM:

added 665 characters in body
Source Link
Feyre
  • 8.7k
  • 2
  • 30
  • 48

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]}]) // 
  DeleteDuplicates
pos = Table[
Flatten[Position[flistDeleteDuplicates@Flatten[Position[flist, flistDD[[i]]]], {i, Length[flistDD]}]

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]}

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 = (flist = Table[xterms[f[[i]]], {i, Length[f]}]) // 
  DeleteDuplicates
pos = Table[
Flatten[Position[flist, flistDD[[i]]]], {i, Length[flistDD]}]

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

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]}])
pos = Table[
DeleteDuplicates@Flatten[Position[flist, flistDD[[i]]]], {i, Length[flistDD]}]

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]}

added 67 characters in body
Source Link
Feyre
  • 8.7k
  • 2
  • 30
  • 48

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];

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 = (flist = Table[xterms[f[[i]]], {i, Length[f]}]) // 
  DeleteDuplicates

{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[
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.

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];

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 = (flist = Table[xterms[f[[i]]], {i, Length[f]}]) // 
  DeleteDuplicates

{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[
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]}

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];

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 = (flist = Table[xterms[f[[i]]], {i, Length[f]}]) // 
  DeleteDuplicates

{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[
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.

Removed superfluous list depth
Source Link
Feyre
  • 8.7k
  • 2
  • 30
  • 48
Loading
Source Link
Feyre
  • 8.7k
  • 2
  • 30
  • 48
Loading