# Simplifying $a_1^k\times a_2^{k+2}+a_3^k\times a_4^{k+2} \to a_2^2\times (a_1\times a_2)^k+a_4^2\times (a_3\times a_4)^k$

Consider the following expression that Mathematica returned me after a calculation:

Res=1/77 (-107 3^(1 + k) 7^k + 199 2^(1 + k) 49^k)

As you can see, Mathematica did not really regroup the terms by power of $$k$$. What I would like is to see something like:

FixedRes=1/77 (-321*21^k + 398*98^k)

More generally I would like to do something like:

$$a_1^k*a_2^{k+2}+a_3^k*a_4^{k+2} \to a_2^2*(a_1*a_2)^k+a_4^2*(a_3*a_4)^k$$

How can I do it? I saw the function "Collect" but it does not solve the same issue I am asking. It is used to regroup terms a sum of terms in power of a fixed variable $$x$$ as a sum of separate $$x^k$$. I am somehow asking to regroup terms having a same power as variable.

• This will be little hard without using Hold or Inactive and such family of commands. Because Mathematica will do automatic rewrite. Here is screen shot !Mathematica graphics You see, it automatically writes $3 (3\times7)^k$ as $3^{1+k} 7^k$ instead of $3\times 21^k$ Feb 15, 2023 at 14:09
• ps. fixed your latex in title. In Latex * is not used for multiplication. Better to use $\times$ Feb 15, 2023 at 14:15
• Try: res // Expand // Simplify Feb 15, 2023 at 15:21
• @DanielHuber it does not work. They want same output as FixedRes Feb 15, 2023 at 15:31
• I get, from Res // Expand // Simplify the output: 1/11 7^(-1 + k) (-107 3^(1 + k) + 199 2^(1 + k) 7^k). My version of MMA is 13.2 Feb 15, 2023 at 15:51

If you don't care efficiencies,

powerRule1[power_] :=
{
IgnoringInactive[x_^(power*k1_.+rest1_.)*y_^(power*k2_.+rest2_.)]:>
With[ {var = x^k1*y^k2//Simplify},
If[ IntegerQ[x]||IntegerQ[y],
Inactivate[var^power,Power|Sqrt],
var^power
]
]*x^rest1*y^rest2
};
res//.powerRule1[k]

This is a function I wrote long time ago and have never tested carefully.

powerCollectkernel[][expr_] :=
expr//ReplaceRepeated[powerRulecollect[]];
powerCollectkernel[power_][expr_] :=
expr//ReplaceRepeated[powerRulecollect[power]];
powerCollectkernel[power1_,powerRest__][expr_] :=
powerCollectkernel[powerRest][
powerCollectkernel[power1][expr]
];

powerCollect//Options={"wrapper"->Activate};
powerCollect[powers___,opts:OptionsPattern[]][expr_]:=
powerCollectkernel[powers][expr]//OptionValue["wrapper"];

powerRulecollect[power_] :=
{
IgnoringInactive[x_^(power*k1_.+rest1_.)*y_^(power*k2_.+rest2_.)]:>
With[ {var = x^k1*y^k2//Simplify},
If[ IntegerQ[x]||IntegerQ[y],
Inactivate[var^power,Power|Sqrt],
var^power
]
]*x^rest1*y^rest2,
powerRulemergeNestedPower,
powerRulecancelMinus
};

powerRulecollect[] = {
IgnoringInactive[x_^(power_*k1_.+rest1_.)*y_^(power_*k2_.+rest2_.)]:>
With[ {var = x^k1*y^k2//Simplify},
If[ IntegerQ[x]||IntegerQ[y],
Inactivate[var^power,Power|Sqrt],
var^power
]
]*x^rest1*y^rest2,
powerRulemergeNestedPower,
powerRulecancelMinus
};

powerRulemergeNestedPower =
IgnoringInactive[(x_^a_)^b_]:>x^(a*b);

powerRulecancelMinus =
IgnoringInactive[(-1*rest_.)^(k_Integer*a_.+b_.)]/;EvenQ@k:>
(-1)^b*rest^(k*a+b);