2
$\begingroup$

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] = 0;
normalize[_?ExactNumberQ] = 1;
normalize[z_Times] := DeleteCases[z, _?ExactNumberQ];
normalize[z_] := z;

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

Could you suggest anything better?

Improve this question
$\endgroup$
2
  • $\begingroup$ Replace[x, r_?ExactNumberQ :> 1, {0, 1}]? $\endgroup$ – J. M.'s ennui♦ Jul 27 '15 at 18:51
  • $\begingroup$ Nope, I have to check for the Times head, otherwise it will corrupt terms like PolyGamma[0, 1/Sqrt[2]]. $\endgroup$ – ěŕëĺíüęŕ͘  ěţěëŕ Jul 27 '15 at 19:02
1
$\begingroup$

This should work:

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

(* {1, EulerGamma, Log[2], PolyGamma[1, 1/Sqrt[2]], Sqrt[2] Log[1 + Sqrt[2]]}*)
Improve this answer
$\endgroup$
2
  • 1
    $\begingroup$ …notice that the digamma function in the fourth entry has suddenly become a trigamma function. $\endgroup$ – J. M.'s ennui♦ Jul 27 '15 at 19:33
  • $\begingroup$ 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. $\endgroup$ – bobknight Jul 27 '15 at 19:35
0
$\begingroup$

I believe

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

concisely satisfies all of your criteria. Consider:

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

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

Improve this answer
$\endgroup$
0
$\begingroup$

Possibly you could use FactorTermsList:

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

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

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.