1
$\begingroup$

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}
$\endgroup$
  • $\begingroup$ Shouldn't p[1]^2 p[2] be p[1] pro? $\endgroup$ – Kuba Oct 25 '17 at 12:18
  • $\begingroup$ @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? $\endgroup$ – BoLe Oct 25 '17 at 12:23
  • 2
    $\begingroup$ Eliminate[ {exp == 0, pro == p[1] p[2], sum == p[1] + p[2]}, {p[1], p[2]}] $\endgroup$ – Kuba Oct 25 '17 at 12:25
  • $\begingroup$ @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. $\endgroup$ – BoLe Oct 25 '17 at 12:30
4
$\begingroup$

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.

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

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.