Pattern transformation to implement "factoring out"

Question

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.

Answer 1

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

Answer 2

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}