1
$\begingroup$

I'm attempting to put together some code that would do pattern based expression manipulation (I know it's already implemented in mathematica), but I'm getting stuck on a pattern to deal with "factoring out".

I'm trying to construct a pattern that would match expressions similar to:

a*b+a*c+a*d

and transform them into

a*(b+c+d)

Ideally, this would for any expressions, for example

Log[x^2]*Sin[x]+Log[x^2]*Cos[x]+Log[x^2]-Log[x^2]^2

would get transformed into

Log[x^2]*(Sin[x]+Cos[x]+1-Log[x^2])

Going back to the much simpler a*b+a*c+a*d, what I'm trying is something along the lines of

Plus[Times[x_, tail__] ..] :> x_*Plus[Times[tail__]]

However that doesn't work (and I'm aware it can't), I just can't figure out the proper way to express what I mean. On top of that, I seem to be completely unable to match at least part of the expression at all, for example I would expect this:

Replace[a*b + a*c + a*d, Plus[Times[x_, _] ..] :> {x}]

To return {a}, but it doesn't match anything.

Can someone nudge me in the correct direction?

EDIT 1: it’s important that this is done in one step, see bellow.

EDIT 2: To give more context, we’re trying to prototype an app that would take two (high-school level) expressions and determine if they are equivalent. The reason we’re using patterns and not Simplify (or something similar) is that the eventual ambition is to write the app in a different, non-commercial language.

The way we approach this is, for each of the two expressions, we generate a set of “one step equivalent” expressions using ReplaceList and the patterns we have, by which we mean all expressions which can be created from the previous expression in one step. The patterns include things such as expanding products, putting two fractions over a common denominator etc.

We then iterate and repeat this process for each newly created expression, keeping track of all expressions created and always check if the two sets haven’t started overlapping - if they have, we consider the expressions equal, if not (in a certain amount of steps), we consider them not equal.

Now we have probably around 8 patterns, and application of even a single one can give many results through ReplaceList, so the combinatorial explosion is quite large. In practice, my MacBook can’t handle more than 4 iterations. Because of this, we are trying to find patterns which match all possible combinations in a single step, so the pattern we’re looking for, when applied to ab+ac+ad using ReplaceList, should give {a(b+c)+ad, a(c+d)+ab, a(b+d)+ac, a(b+c+d)} in a single step.

The only reason for this is performance, in theory we would get exactly the same results if we use patterns which do the same thing but pairwise and just apply them repeatedly. Unfortunately, in practice we would need many more iterations than 3-4 to get to the result, and that is simply not feasible.

$\endgroup$
  • 2
    $\begingroup$ Simplify gives the desired result in both examples. $\endgroup$ – kglr Oct 1 '18 at 21:38
  • 1
    $\begingroup$ I am aware of that, however that is not what I'm looking for - I'm trying to implement the logic myself $\endgroup$ – Gabriel Shanahan Oct 2 '18 at 15:42
1
$\begingroup$

I can provide this one, which with ReplaceRepeated will eventually do the bracketing (hopefully):

a*b + a*c + a*d + e //. 
 Plus[Times[A_, x_], Times[A_, y_], z___] :> Plus[A Plus[x, y], z]

a (b + c + d) + e

$\endgroup$
  • 1
    $\begingroup$ Hey Henrik, thank you very much for the tip. Unfortunatelly, this doesn’t exactly solve my use case, I’m trying to find something that would match any number of such terms in one step (so I can get them all using ReplaceList). I edited the OP to give more info. $\endgroup$ – Gabriel Shanahan Oct 3 '18 at 7:30
  • $\begingroup$ Hm. You should add that requirement to your question. $\endgroup$ – Henrik Schumacher Oct 3 '18 at 7:35
  • $\begingroup$ Yes, good point, sorry about that. I edited the OP $\endgroup$ – Gabriel Shanahan Oct 3 '18 at 7:52
0
$\begingroup$

Got it!

Plus[head___, sum : Repeated[Times[A_, _], {2, Infinity}], tail___] :> Plus[head, A*DeleteCases[A] /@ Plus[sum], tail]

The following

ReplaceList[a*b + a*c*d + a*d + e, Plus[head___, 
   sum : Repeated[Times[A_, _], {2, Infinity}], tail___] :> 
  Plus[head, A*DeleteCases[A] /@ Plus[sum], tail]]

Gives

{a c d + a (b + d) + e, a d + a (b + c d) + e, a b + (a + a c) d + e, 
 a b + a (d + c d) + e, a (b + d + c d) + e, a b + (a + a c) d + e, 
 a b + a (d + c d) + e, a d + a (b + c d) + e, a c d + a (b + d) + e, 
 a c d + a (b + d) + e, a d + a (b + c d) + e, a b + (a + a c) d + e, 
 a b + a (d + c d) + e, a (b + d + c d) + e, a b + (a + a c) d + e, 
 a b + a (d + c d) + e, a d + a (b + c d) + e, a c d + a (b + d) + e}
$\endgroup$

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.