Substitution to write out powers of expressions

Question

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?

Answer 1

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.

Answer 2

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.