2
$\begingroup$

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?

|improve this question
$\endgroup$
  • $\begingroup$ Why do you want to do that? What do you plan to do with that expression after the replacement? $\endgroup$ – Dr. belisarius May 14 '13 at 17:19
  • $\begingroup$ Is it for display only? If not, Mathematica will reevaluate something like b b to b^2 automatically $\endgroup$ – Rojo May 14 '13 at 17:20
  • $\begingroup$ 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. $\endgroup$ – Kagaratsch May 14 '13 at 17:23
  • $\begingroup$ Won't those substitutions depend on lexical order? $\endgroup$ – SEngstrom May 14 '13 at 17:27
  • $\begingroup$ I checked that (a b c)/(d e g) /. (a b)/e -> q works fine. Problems come up if the powers are not matching. $\endgroup$ – Kagaratsch May 14 '13 at 17:29
1
$\begingroup$

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.

|improve this answer
$\endgroup$
  • $\begingroup$ 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? $\endgroup$ – Kagaratsch May 14 '13 at 17:42
  • $\begingroup$ 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. $\endgroup$ – Māris Ozols May 14 '13 at 17:52
  • $\begingroup$ Even removing the Sign around p still gives -1. $\endgroup$ – Kagaratsch May 14 '13 at 17:56
  • $\begingroup$ 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). $\endgroup$ – Māris Ozols May 14 '13 at 17:58
  • 2
    $\begingroup$ 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. $\endgroup$ – rm -rf♦ May 14 '13 at 18:13
1
$\begingroup$

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.

|improve this answer
$\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.