Replace sum x+y+z in expressions like 2x+3y+z

Question

Related threads replacing-a-sum-of-expressions and Replace a sum of squared variables by a new squared variable

Given the identity $x+y+z=p$ I'd like to simplify the generic expression

$$kx+ly+mz$$

where $k$, $l$, $m$ are positive integer coefficients, but ultimately this shouldn't matter.

The naive ansatz would be to use the rule

HoldPattern[Plus[x,y,z]]->p

This works fine when $k=1$, $l=1$, and $m=1$ but fails in all other cases. Now the accepted answer in the first linked post, states that you need to define all the rules manually. But this gives this massive object, which leads to $2^c$ possibilities, where $c$ is the number of coefficients.

  HoldPattern[Plus[x, y, z]] -> p,
  HoldPattern[Plus[Times[a_?IntegerQ, x], y, z]] :> 
   Plus[Times[a - 1, x], y, z, p],
  HoldPattern[Plus[Times[a_?IntegerQ, y], x, z]] :> 
   Plus[Times[a - 1, y], x, z, p],
  HoldPattern[Plus[Times[a_?IntegerQ, z], x, y]] :> 
   Plus[Times[a - 1, z], x, y, p],
  HoldPattern[Plus[Times[a_?IntegerQ, x], Times[b_?IntegerQ, y], z]] :>
    Plus[Times[a - Min[a, b], x], Times[b - Min[a, b], y], z, p],
  HoldPattern[Plus[Times[a_?IntegerQ, x], Times[b_?IntegerQ, z], y]] :>
    Plus[Times[a - Min[a, b], x], Times[b - Min[a, b], z], y, p],
  HoldPattern[Plus[Times[a_?IntegerQ, y], Times[b_?IntegerQ, z], x]] :>
    Plus[Times[a - Min[a, b], y], Times[b - Min[a, b], z], x, p],
  HoldPattern[
    Plus[Times[a_?IntegerQ, x], Times[b_?IntegerQ, y], 
     Times[c_?IntegerQ, z]]] :> 
   Plus[Times[a - Min[a, b, c], x], Times[b - Min[a, b, c], y], 
    Times[c - Min[a, b, c], z], Times[Min[a, b, c], p]]
  }

It should be obvious, that

There is a lot of repetition in this code and as a consequence
This generalizes very badly, due to the exponential scaling of the possibilities

Example expected results:

$5x+2y+3z=3x+z+2p$
$3x+2y$ should remained unchanged (optionally)
$x+2y+z=p+y$

What is the general way to apply the above identity to any expression?

Additional requirement (edited): $p$ should be able to be a more complicated expression, not necessarily atomic.

maybe Eliminate[{ss == 5 x + 2 y + 3 z, p == x + y + z}, y]? — kglr, Oct 09 '20 at 15:34
Is there a requirement that all of the coefficients (except for $p$?) should be positive? — Carl Woll, Oct 09 '20 at 15:56
@Eric Towers: because that would make the expression more complicated, if it was only z — infinitezero, Oct 10 '20 at 14:10

score 6 · Answer 1 · answered Oct 09 '20 at 17:00

You can use PolynomialReduce for this:

reduce[e_, p_Symbol->r_, v_List] := Module[{min},
    min = First @ Ordering[Coefficient[e,#]&/@v];
    Replace[
        PolynomialReduce[e, r, v[[min]]],
        {{n_}, s_} :> s + n p
    ]
]

Then:

reduce[3x + 2y + 5z, p -> x + y + z, {x, y, z}]
reduce[3x + 2y, p -> x + y + z, {x, y, z}]

2 p + x + 3 z

3 x + 2 y

evanb · Accepted Answer · 2020-10-09T18:27:04.887

5

You can build another kind of rule

rule = a_. x + b_. y + c_. z :> (((a - min) x + (b - min) y + 
                               (c - min) z + min p) /. {min -> Min[a, b, c]})

Then

(5x+2y+3z /.rule) == 2p+3x+z
(3x+2y /.rule) == 3x + 2y

edited Oct 09 '20 at 18:27

answered Oct 09 '20 at 18:04

evanb

6,026
18
30

This only works if a, b AND c are not equal to 1. – infinitezero Oct 09 '20 at 18:25
You're right---I added the . at the end of a_., b_. and c_. to match the default in times, now it includes 1. – evanb Oct 09 '20 at 18:27
That is awesome, I didn't know about it. Where can I find it in the documentation? – infinitezero Oct 09 '20 at 18:35
1

It's under ref/Default in the docs. https://reference.wolfram.com/language/ref/Default.html – evanb Oct 09 '20 at 18:37
The Default of Times is 1---the multiplicative identity. Similarly, the default of Plus is 0. – evanb Oct 09 '20 at 18:37
When some of the coefficients are negative this may not give the desired result. I recommend that you change {min -> Min[a, b, c]}) to {min -> SortBy[{a, b, c}, Abs][[1]]} – Bob Hanlon Oct 10 '20 at 02:16
I added a condition to this that all coefficients are positive, but interesting point, @Bob Hanlon – infinitezero Oct 10 '20 at 14:11

score 3 · Answer 3 · answered Oct 09 '20 at 15:39

Clear["Global`*"]

repl[expr_, vars : _List : {z, y, x}, p : _Symbol : p] :=
 SortBy[expr /.
     (Solve[Total[vars] == p, #][[1]] & /@ vars) // Simplify,
   LeafCount][[1]]

5 x + 2 y + 3 z // repl

(* 2 p + 3 x + z *)

3 x + 2 y // repl

(* 3 x + 2 y *)

kglr · Answer 4 · 2020-10-11T18:34:59.407

1

ClearAll[f0]
f0 = Module[{$v}, $v /. Solve[Eliminate[{$v == #, #2}, #3], $v][[1]]] &;

Examples:

f0[a x + b y + c z, p == x + y + z, y] // Simplify

a x + b (p - x - z) + c z

f0[5 x + 2 y + 3 z, p == x + y + z, y]

2 p + 3 x + z

f0[5 x + 2 y + 3 z, p == x + y + z, z]

3 p + 2 x - y

f0[ 3 x + 2 y, p == x + y + z, z]

3 x + 2 y

f0[ x + 2 y + z, p == x + y + z, z]

p + y

f0[ x + 2 y + z, p == x + y + z, y]

2 p - x - z

edited Oct 11 '20 at 18:34

answered Oct 09 '20 at 21:07

kglr

394,356
18
477
896

Something looks wrong with signs. For example, should the first result have -c*z as opposed to c*z? – Daniel Lichtblau Oct 10 '20 at 20:20
2

By the way, eliminate is not the best maintained of functions. PolynomialReduce is now the recommended way to go about these things. But if you really want to live on the wild side, I'd say go with AlgebraicRules. Since it is no longer documented I'll show it in all its glory: replaceBy[p1_, p2_, vars_] := p1 /. AlgebraicRules[p2, Join[vars, Complement[Variables[{p1, p2} /. Equal -> List], vars]]] (I was forgetting just how much I dislike this function.) – Daniel Lichtblau Oct 10 '20 at 20:24
Thank you @Daniel for both pointers. (Updated with a fix for the sign issue.) – kglr Oct 11 '20 at 18:36

Replace sum x+y+z in expressions like 2x+3y+z

4 Answers4