Replacing all constant factors in expressions by +1

Question

I have expressions like $a - b + c(d-\frac12 e) + \frac{f-i g}{h}$ where $i$ is the imaginary number. I would like to remove all minus signs (and if possible, also get rid of constants such as $\frac12$ or $i$, to obtain $a + b + c(d+e) + \frac{f+g}{h}$.

Is there a way to do this in mathematica? My attempts at defining a suitable replacement rule have not succeeded so far.

Answer 1

It seems that your question boils down to replacing all numerical multiplicative factors with 1, which is directly implemented as

exp = a - b + (f - I g)/h + c (d - e/2); 
exp //. {Times[pre___, n_?NumericQ, post___] :> Times[pre, post]}

(* a + b + c (d + e) + (f + g)/h *)

I've tested this on a number of different cases and it seems pretty robust.

Answer 2

Update: A variant of @Daniel W's idea:

times = Times @@ DeleteCases[{##}, _?NumericQ] &;
numbersToOne = # /. Times -> times &;

numbersToOne[a - b + c (d - 1/2 e) + (f - g I)/Sqrt[h]]

a + b + c (d + e) + (f + g)/h

numbersToOne[a - b + c (d Pi - 1/2 e) + (f E - g I)/Sqrt[h]]

a + b + c (d + e) + (f + g)/Sqrt[h]

Original answer:

exp = a - b + (f  - I g)/h + c (d - e/2);
replaceNumbers = # /.  Power[a_, b_?NumericQ] :> Power[a, ToString[b, StandardForm]] /. 
     x_?NumericQ :> 1 /. s_String :> ToExpression[s] &

replaceNumbers @ exp

a + b + c (d + e) + (f + g)/h

replaceNumbers @ (a - b + c (d Pi - 1/2 e) + (f E - g I)/Sqrt[h])

a + b + c (d + e) + (f + g)/Sqrt[h]

Answer 3

Another idea is to use Collect:

Collect[(a - b + c (d - 1/2 e) + (f - g I)/h), _Symbol, 1&]

a + b + c (d + e) + f/h + g/h

Answer 4

As a complement to Daniel W's answer, due to the Attributes of Times his replacement may be greatly simplified as follows:

expr = -(7 I a π z)/(83 d);  (* just an example *)

expr /. x_*_?NumericQ :> x

(a z)/d

Note:

• ReplaceRepeated is not needed.
• BlankNullSequence is not used.
• The right-hand-side is simply x.

An illustration of the key attributes Flat, NumericFunction, and Orderless using a head other than Times:

Attributes[foo] = {Flat, NumericFunction, Orderless};

foo @@ expr /. foo[x_, n_?NumericQ] :> {x, n}

{foo[a, 1/d, z], foo[-((7 I)/83), π]}