# Selective replacements

I would like to replace parts of the expression, with variables p[1] and p[2], that are invariant under inversion p[1] <-> p[2]. Namely I would like to replace p[1] * p[2] as pro, and p[1] + p[2] as sum.

exp = x /. Solve[{
x == 2 p[1] p[2] + p[1] q[2] (2 + x) + q[1] (1 + y),
y == 2 p[1] p[2] + q[1] p[2] (2 + y) + q[2] (1 + x)},
{x, y}][[1]] /. q[i_] :> 1 - p[i] // Simplify


This is nearly there, but for this expression specifically. Although I think my goal is posed loosely, my question is: how would I go about this in a convenient way?

MapAt[ExpandAll
, exp, {2}] //. {p[1]^a_.*p[2]^a_. :> pro^a, b_.*p[1] + b_.*p[2] :> b*sum}

• Shouldn't p[1]^2 p[2] be p[1] pro? – Kuba Oct 25 '17 at 12:18
• @Kuba Yes, hence nearly. Ok, I see I can replace general pattern p[1]^a_.*p[2]^b_. correctly. Can I do without prior ExpandAll selective mapping? – BoLe Oct 25 '17 at 12:23
• Eliminate[ {exp == 0, pro == p[1] p[2], sum == p[1] + p[2]}, {p[1], p[2]}] – Kuba Oct 25 '17 at 12:25
• @Kuba No, not what I would like to have. The expression is not totally invariant, I'd like to replace just the invariant parts and see what is left that is not invariant ... I can do it by hand quickly. – BoLe Oct 25 '17 at 12:30

You could use Simplify/FullSimplify with ComplexityFunction to indicate the correctness of the output.

t1[e_] := ReplacePart[e, RandomChoice[Position[e, p[1]]] -> pro/p[2]]
t2[e_] := ReplacePart[e, RandomChoice[Position[e, p[2]]] -> pro/p[1]]
t3[e_] := ReplacePart[e, RandomChoice[Position[e, p[1]]] -> sum - p[2]]
t4[e_] := ReplacePart[e, RandomChoice[Position[e, p[2]]] -> sum - p[1]]

FullSimplify[exp, TransformationFunctions -> {t1, t2, t3, t4, Automatic},
ComplexityFunction -> (LeafCount[#] + Length[Position[#, p[1] | p[2]]] &)]


$\frac{(p(1)-1) \text{pro}+2}{\text{pro} (\text{pro}-\text{sum}+2)}$

Maybe multiply the second term of the complexity function by more than 1.

• This is sort of amazing. Also works: -> RandomChoice[{pro/p[2], sum - p[2]}]], halving the number of t's. – BoLe Oct 26 '17 at 12:52