5
$\begingroup$

I have an expression like $(f[t])^{a+b} (g[t])^{-a-c}$ and I want to get it in a form where I collect the functions under the same power. For example, I would want the above in the following form:
$\left(\dfrac{f[t]}{g[t]}\right)^a (f[t])^b (g[t])^{-c}$.

from:

 f[t]^(a + b)*g[t]^(-a - c) 

to:

(f[t]/g[t])^a*f[t]^b*g[t]^-c

Is there away for mathematica to do this for me?

$\endgroup$
  • 3
    $\begingroup$ Note that your two forms are not equivalent, e.g., they give different results for f[t]->-1, g[t]->-I, a->1/2. $\endgroup$ – Carl Woll Aug 18 '18 at 1:07
  • $\begingroup$ @CarlWoll Oh, right. So, is there a way to collect in same powers under some assumptions? For example, if I input an assumption that both of the above functions are real and positive for every $t$. $\endgroup$ – TheQuantumMan Aug 18 '18 at 15:58
4
$\begingroup$

If the question is about explicit symbolic powers of the form x^(a+b+...), then this should do the trick:

expr = f[t]^(a + b) * g[t]^(-a - c) * h[t]^(a + d) * w[t]^(-a - e) q[t]^a * r[t]^-a;
expr //. {
   Power[x_, a_ + r1_: 0] Power[y_, -a_ + r2_: 0] :> 
       Power[x/y, a] Power[x, r1] Power[y, r2],
   Power[x_, a_ + r1_: 0] Power[y_, a_ + r2_: 0] :> 
       Power[x y, a] Power[x, r1] Power[y, r2]
}
(* Returns: f[t]^b g[t]^-c h[t]^d ((f[t] h[t] q[t])/(g[t] r[t] w[t]))^a w[t]^-e*)

where I have added extra terms to make the example more general.

EDIT

Meanwhile, an idea came to my mind that it might be not obvious for someone reading this answer that the trick will work when there are more than two terms in the Power:

x^(a + b + c) y^(-a + d + e)

But it will work because Plus is Flat.

x^(a + b + c) y^(-a + d + e) //. {
  Power[x_, a_ + r1_: 0] Power[y_, -a_ + r2_: 0] :> 
    Power[x/y, a] Power[x, r1] Power[y, r2], 
  Power[x_, a_ + r1_: 0] Power[y_, a_ + r2_: 0] :> 
   Power[x y, a] Power[x, r1] Power[y, r2]
}
(*Returns x^(b + c) (x/y)^a y^(d + e)*)

I should have included such terms in the first example.

EDIT2

While the code above is elegant and does the job, it might be not very efficient because the pattern matcher will try quite a lot of combinations. Here is a less elegant but more straight forward approach, which just splits Powers and then gathers them together.

First, we split Powers:

Flatten[
  Replace[
    List @@ expr,
    Power[x_, pow_: 1] :> Thread[power[x, Replace[pow, Plus -> List, {1}, Heads -> True]]],
    {1}
  ]
]
(*Returns: {power[f[t],a],power[f[t],b],power[g[t],-a],power[g[t],-c],power[h[t],a],power[h[t],d],power[q[t],a],power[r[t],-a],power[w[t],-a],power[w[t],-e]}*)

where I have introduced an auxiliary symbol power to keep 1 as a power for gathering purposes; then we gather Powers:

GatherBy[
 %,
 Composition[Abs, Last]
]
(*Returns: {{power[f[t],a],power[g[t],-a],power[h[t],a],power[q[t],a],power[r[t],-a],power[w[t],-a]},{power[f[t],b]},{power[g[t],-c]},{power[h[t],d]},{power[w[t],-e]}}*)

make negative powers positive ones of reverse expressions:

Replace[
  %,
  power[x_, -y_] :> power[1/x, y],
  {2}
]
(*Returns: {{power[f[t],a],power[1/g[t],a],power[h[t],a],power[q[t],a],power[1/r[t],a],power[1/w[t],a]},{power[f[t],b]},{power[1/g[t],c]},{power[h[t],d]},{power[1/w[t],e]}}*)

and collect them together:

Times @@ Replace[
  %,
  x : {power[_, pow_] ...} :> Power[Times @@ x[[All, 1]], pow],
  {1}
]
(*Returns: f[t]^b (1/g[t])^c h[t]^d (1/w[t])^e ((f[t] h[t] q[t])/(g[t] r[t] w[t]))^a*)

resulting in the final function:

collectTerms[expr_Times]:=Times@@Replace[
  Replace[
    GatherBy[
      Flatten[
        Replace[
          List@@expr,
          Power[x_, pow_:1] :> Thread[power[x, Replace[pow, Plus->List, {1}, Heads->True]]],
          {1}
        ]
      ],
      Composition[Abs,Last]
    ],
    power[x_, -y_] :> power[1/x, y],
    {2}
  ],
  x:{power[_, pow_]...} :> Power[Times@@x[[All,1]], pow],
  {1}
];

If it is crucial to leave expressions like g[t]^(-c) untouched, then we can change the third step a little bit to make negative powers positive only if there are more then one relevant powers having been collected:

Replace[
  %,
  pows_ /; Length[pows] > 1 :> Replace[
    pows,
    power[x_, -y_] :> power[1/x, y],
    {1}
  ],
{1}
]

instead of

Replace[
  %,
  power[x_, -y_] :> power[1/x, y],
  {2}
]
$\endgroup$
1
$\begingroup$

With the help of the function factorizeyou can separate out the factor of your wish:

factorize[expr_, factor_, function_] := factor*function[expr/factor];

(the variables: factor is what you wish to take out, function is a function to apply to the ratio of your initial expression and the factor. The idea is that after this division you have to transform it somehow, such that Mma will not transform it back. Typical functions would be Expand and PowerExpand, but some others are sometimes also useful.

factorize[expr, (f[t]/g[t])^a, PowerExpand]

(*   f[t]^b (f[t]/g[t])^a g[t]^-c *)

Have fun!

$\endgroup$

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.