# Substitution to write out powers of expressions

I am looking for a substitution command which will write out powers of expressions like this:

$$\frac{a ~b^3~ c}{d~ e^{3/2}~ f^2}\to \frac{a ~b~b~b~ c}{d~ e^{1/2}~ e^{1/2}~ e^{1/2}~ f~f}$$

mathematica code to experiment with:

(a b^3 c)/(d e^(3/2) f^2)


Please note, this is needed to carry out substitutions on very large expressions, so that a ComplexityFunction is not an option since a Simplify will take forever to evaluate.

EDIT

I want to do this since I plan to apply substitutions for expressions like

$$\frac{a b}{e^{1/2}}\to q ~~~\text{ and } ~~~\frac{b}{e^{1/2}f}\to p$$

which do not get recognized while all the terms are cluttered into one heap.

EDIT2

Maybe, as some point to start with, I should ask how to make mathematica take some literate input without performing any kind of simplification to it. Such that an input $b+b$ would still display as $b+b$ instead of the automatic $2b$? Is this possible?

-
Why do you want to do that? What do you plan to do with that expression after the replacement? –  belisarius May 14 '13 at 17:19
Is it for display only? If not, Mathematica will reevaluate something like b b to b^2 automatically –  Rojo May 14 '13 at 17:20
I plan to apply substitutions for expressions like $\frac{a b}{e^{1/2}}\to q$ and $\frac{b}{e^{1/2}f}\to p$ which do not get recognized while all the terms are cluttered into one heap. –  Kagaratsch May 14 '13 at 17:23
Won't those substitutions depend on lexical order? –  SEngstrom May 14 '13 at 17:27
I checked that (a b c)/(d e g) /. (a b)/e -> q works fine. Problems come up if the powers are not matching. –  Kagaratsch May 14 '13 at 17:29

You can use the following code

Repeat[x_, n_] := Row@ConstantArray[x, {n}];
expr /. Power[x_, Rational[p_, q_] | p_] :> Repeat[x^(Sign[p]/(1*q)), Abs@p]


where expr is your expression. This will display things the way you wanted. If you don't need things to be displayed, you can just leave the Repeat function undefined.

-
Works great on some power of a square root but with something like (e^(3/2) b^3)/a^2 it reverses the sign in the exponent of $b$ and $a$. Any idea on how to fix this? –  Kagaratsch May 14 '13 at 17:42
That is very strange. Variable q should have default value 1. However, it is undefined and for some reason Sign[p]/q ends up equal to -1. Let me see how to fix this. –  Māris Ozols May 14 '13 at 17:52
Even removing the Sign around p still gives -1. –  Kagaratsch May 14 '13 at 17:56
It seems that the default value 1 for q made no difference so I removed it. I'm not sure what q is initialized to now. However, I multiplied it by 1 and it somehow magically works. I'm not sure what is going on here. It could be a bug (maybe you should post that as a separate question). –  Māris Ozols May 14 '13 at 17:58
Using structural modifications (rule replacements) for mathematical gymnastics is not a good idea and usually works only for the simplest of cases. You'll always run into cases where it doesn't work, which forces you to keep modifying/extending the pattern, which is an endless game. The correct way to approach OP's problem would be via Solve/Reduce/Eliminate, etc. –  The Toad May 14 '13 at 18:13

This answer is only for exercise. It works only with products but I believe it can be eaily extended. Also for exercise, because I think rm -rf is right about approach.

I've taken Māris Ozols formula and extended it.

EDIT: it works now with integer and rational powers

sub[expr_, parts_, var_] := Module[{reduce, p, n, list, ct, red, l2},
reduce := {If[MatchQ[Head[#], Symbol], 1, #] & /@ # /.
Power[_, y_] :> y, # /. Power[x_, y_] :> x}\[Transpose] &;
p = reduce@parts;
n = reduce@Cases[expr, Times[l_] :> l];

list = n /. {x_, a_?(MemberQ[p[[All, 2]], #] &)} :> With[
{en = Select[n, MatchQ[#[[2]], a] &][[1, 1]],
pn = Select[p, #[[2]] == a &][[1, 1]]},
If[Floor[en/pn] >= 0,
{Table[a^pn, {i, Floor[en/pn]}]~Join~{a^Mod[en, pn]}},
a]
] // Flatten;
ct = Min[Count[list, #] & /@ parts];
red = Nest[{(i = #[[2]] + 1;
DeleteCases[#[[1]], parts[[i]], 1, ct]), i} &, {list, 0},
Length@parts][[1]];
l2 = red~Join~Table[var, {i, ct}];
Times @@ l2]


so lets check it:

expr=(a b^3 c)/(d e^(3/2) f^2);
parts={a,b,e^(-1/2)}; (*parts of element to replace*)

sub[expr,parts, q]


In output there should be expr with a*b/(e^(-1/2)) replaced by q. It works for me.

If someone has suggestions how to improve this code (not this answer, only code, different functions or comends etc.), thanks in advance.

-