6
$\begingroup$

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

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

Example expected results:

  1. $5x+2y+3z=3x+z+2p$
  2. $3x+2y$ should remained unchanged (optionally)
  3. $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.

$\endgroup$
6
  • 1
    $\begingroup$ maybe Eliminate[{ss == 5 x + 2 y + 3 z, p == x + y + z}, y]? $\endgroup$
    – kglr
    Oct 9, 2020 at 15:34
  • 1
    $\begingroup$ Is there a requirement that all of the coefficients (except for $p$?) should be positive? $\endgroup$
    – Carl Woll
    Oct 9, 2020 at 15:56
  • 1
    $\begingroup$ For more complex expression, look at PolynomialReduce $\endgroup$ Oct 9, 2020 at 16:14
  • $\begingroup$ @CarlWoll, yes they are all positive. $\endgroup$ Oct 9, 2020 at 16:34
  • $\begingroup$ Why not z -> p-x-y? $\endgroup$ Oct 10, 2020 at 2:26

4 Answers 4

5
$\begingroup$

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
$\endgroup$
7
  • $\begingroup$ This only works if a, b AND c are not equal to 1. $\endgroup$ Oct 9, 2020 at 18:25
  • $\begingroup$ You're right---I added the . at the end of a_., b_. and c_. to match the default in times, now it includes 1. $\endgroup$
    – evanb
    Oct 9, 2020 at 18:27
  • $\begingroup$ That is awesome, I didn't know about it. Where can I find it in the documentation? $\endgroup$ Oct 9, 2020 at 18:35
  • 1
    $\begingroup$ It's under ref/Default in the docs. reference.wolfram.com/language/ref/Default.html $\endgroup$
    – evanb
    Oct 9, 2020 at 18:37
  • $\begingroup$ The Default of Times is 1---the multiplicative identity. Similarly, the default of Plus is 0. $\endgroup$
    – evanb
    Oct 9, 2020 at 18:37
6
$\begingroup$

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

$\endgroup$
3
$\begingroup$
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 *)
$\endgroup$
1
$\begingroup$
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
$\endgroup$
3
  • $\begingroup$ Something looks wrong with signs. For example, should the first result have -c*z as opposed to c*z? $\endgroup$ Oct 10, 2020 at 20:20
  • 2
    $\begingroup$ 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.) $\endgroup$ Oct 10, 2020 at 20:24
  • $\begingroup$ Thank you @Daniel for both pointers. (Updated with a fix for the sign issue.) $\endgroup$
    – kglr
    Oct 11, 2020 at 18:36

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.