# Dropping rational coefficients

I have a list of expressions (they all are exact numeric quantities, not containing any variables), some of them have integer or rationals coefficients, or complex coefficients with rational or integer components. There are no sums of several terms. I am looking for a simple and elegant way to drop those coefficients from all expressions in the list. This is what I wrote so far

ClearAll[normalize];
normalize = 0;
normalize[_?ExactNumberQ] = 1;
normalize[z_Times] := DeleteCases[z, _?ExactNumberQ];
normalize[z_] := z;

normalize /@ {484/45, -16 EulerGamma/3, -8 Log, (48/5 + 2 I/5) Sqrt Log[1 + Sqrt]}
(* {1, EulerGamma, Log, Sqrt Log[1 + Sqrt]} *)


Could you suggest anything better?

• Replace[x, r_?ExactNumberQ :> 1, {0, 1}]? Jul 27, 2015 at 18:51
• Nope, I have to check for the Times head, otherwise it will corrupt terms like PolyGamma[0, 1/Sqrt]. Jul 27, 2015 at 19:02

This should work:

Replace[{484/45, -16 EulerGamma/3, -8 Log,
PolyGamma[0, 1/Sqrt], (48/5 + 2 I/5) Sqrt Log[1 + Sqrt]},
_?ExactNumberQ -> 1, 2]

(* {1, EulerGamma, Log, PolyGamma[1, 1/Sqrt], Sqrt Log[1 + Sqrt]}*)

• …notice that the digamma function in the fourth entry has suddenly become a trigamma function. Jul 27, 2015 at 19:33
• I didn't, thanks. Moreover, if there is a Power[2, Rational[1,2]] at first level it is replaced by 1 and I guess this is not valid. Jul 27, 2015 at 19:35

I believe

Replace[x_.*Except?ExactNumberQ :> x]


concisely satisfies all of your criteria. Consider:

Replace[x_.*Except?ExactNumberQ :> x] /@
{0, 484/45, -16 EulerGamma/3, -8 Log, PolyGamma[0, 1/Sqrt], (48/5 + 2 I/5) Sqrt Log[1 + Sqrt]}


{0, 1, EulerGamma, Log, PolyGamma[0, 1/Sqrt], Sqrt Log[1 + Sqrt]}

Possibly you could use FactorTermsList:

Map[
Last @ FactorTermsList[#, _Symbol]&,
{484/45, -16 EulerGamma/3, -8 Log, (48/5 + 2 I/5) Sqrt Log[1 + Sqrt]}
]


{1, EulerGamma, Log, Sqrt Log[1 + Sqrt]}