Taking the numerator and the denominator

Question

Is there any way to get the Numerator and the Denominator of an expression split in the same way that Mathematica graphically represents it.

Say I have an expression:

(a^(p1 + p2 - p3) b^(p1 - p2 + p3))/(c d)

When plugged into mathematica it gets represented with the $c$ and $d$ in the denominator but if I were to try to extract the numerator and denominator with respectively Numerator and Denominator I would not get the same split. I understand that a different (probably more sensible) choice of representation is made in Numerator and Denominator. However, is it possible to (automatically and reliably) take the denominator and numerator parts as split in the graphical representation? Mathematica must be able to determine this split since it has to decide how to graphically represent the output.

Answer 1

The problem is that the negative terms in the exponent are being included in the denominator. A way to workaround this is to inactivate Plus, use Numerator and Denominator, and reactivate:

expr = (a^(p1+p2-p3) b^(p1-p2+p3))/(c d);

Activate @* Through @* {Numerator, Denominator} @* ReplaceAll[Plus->Inactive[Plus]] @ expr

{a^(p1 + p2 - p3) b^(p1 - p2 + p3), c d}

Answer 2

So, for your particular expression (which is a single fraction), the following kluge works:

expr = (a^(p1 + p2 - p3) b^(p1 - p2 + p3))/(c d);
ToExpression /@ List @@ ToBoxes@expr
(* {a^(p1 + p2 - p3) b^(p1 - p2 + p3), c d} *)

This is a little tricky to automat, because you have to inspect the formatting expression that you get.

---

This uses the visual formatting in the following way. ToBoxes converts the output to front-end formatting:

ToBoxes@expr
(* FractionBox[
    RowBox[{SuperscriptBox["a", RowBox[{"p1", "+", "p2", "-", "p3"}]], " ", SuperscriptBox["b", RowBox[{"p1", "-", "p2", "+", "p3"}]]}],
    RowBox[{"c", " ", "d"}]
   ]  *)

Then, noting that the numerator and the denominator are the first and second elements of the the FractionBox expression, we replace FractionBox with List using List@@, and then convert the remaining formatting expression to Mathematica input expressions using ToExpression.

Answer 3

Here is another option using TeXForm.

expr = (a^(p1 + p2 - p3) b^(p1 - p2 + p3))/(c d);
t = ToString[TeXForm[expr]]

  (* \frac{a^{\text{p1}+\text{p2}-\text{p3}} b^{\text{p1}-\text{p2}+\text{p3}}}{c d} *)

Numerator:

ToExpression[StringCases[t, RegularExpression["frac{(.+)}{(.+)}$"] -> "$1"][[1]], TeXForm]

  (* a^(p1 + p2 - p3) b^(p1 - p2 + p3) *)

Denominator:

ToExpression[StringCases[t, RegularExpression["frac{(.+)}{(.+)}$"] -> "$2"][[1]], TeXForm]

  (* cd *)

Answer 4

Since V 12.0 there is NumeratorDenominator:

expr = (a^(p1 + p2 - p3) b^(p1 - p2 + p3)) / (c d);

res = NumeratorDenominator[expr]

{0.71^(p1 + p3) * a^(p1 + p2), 0.71^p2 * a^p3 * c * d}

Divide @@ res == expr

(* True *)

This is more complicated than Carl Woll's answer which, however, can be simplified to:

Activate @* NumeratorDenominator @* ReplaceAll[Plus -> Inactive[Plus]] @ expr

{0.71^(p1 - p2 + p3) * a^(p1 + p2 - p3), c * d}