Trouble simplifying using Replace

Question

I have the following expression:

w.a.b.r+w.c.d.r

I want to get:

w.(a.b+c.d).r

So far I used ReplaceRepeated:

In= ReplaceRepeated[w.a.b.r+w.c.d.r,{
     Plus[Dot[FRONT__,AA__,BACK__],Dot[FRONT__,BB__,BACK__]]->Dot[FRONT,Plus[AA,BB],BACK]
}]

However this gives:

Out= w.(a+b+c+d).r

Looking into AA shows that it equals:

Sequence[a, b]

Obviously the Dot operator is not begin retained in AA and BB so instead of a.b+c.d I get a+b+c+d. How do I fix this?

Answer 1

To answer the question as asked, we modify the code as follows:

replacementRule = Plus[
  Dot[FRONT__, AA__, BACK__]
  , Dot[FRONT__, BB__, BACK__]
 ] :> Dot[FRONT, Plus[Dot[AA], Dot[BB]], BACK]}]
w.a.b.r + w.c.d.r /. replacementRule

First, we have changed -> (Rule) to :> (RuleDelayed) so that when the expression is re-written, it will write it using the sub-expressions that match FRONT, AA, etc. instead of merely putting in the symbols FRONT, AA, etc.

Second, as the OP noted, AA__ matches a Sequence; in this case AA__ matches Sequence[a, b]. The re-write will not "remember" that a and b are Dotted, so we have to add this in by hand by wrapping AA with Dot.

As to the question that the OP posed in the comments: the OP wants to also re-write more complicated expressions. For instance, write w.g.a.b.r + w.g.c.d.r as w.g.(a.b + c.d).r. With the code as above, we get

w.g.a.b.r + w.g.c.d.r /. replacementRule
(* w.(g.a.b + g.c.d).r *)

The reason is that by default, the pattern matching algorithm matches the longest expression starting from the end of the list. To see what I mean, note that

{a, b, c, d} /. {x__, y__} :> {f[x], g[y]}

results in

{f[a], g[b, c, d]}

The patterns x__ and y__ both stand for sequence of one or more expressions, but since the pattern matching tries to match the longest matching expressions starting from the end of the list, y__ gets matched to Sequence[b, c, d], leaving x__ to match a.

In the OP's example, BACK__ matches only r because it has to match the same sequence of expressions in both expressions that are added together. However, since AA__ and BB__ can be different, the pattern matching eats up as many expressions to the left of r as it can, and this includes the g, leaving FRONT__ to match w.

To fix the problem, we force the pattern-matching to match FRONT__ to the longest sequence of expressions by adding wrapping it in Longest. Since FRONT__ is the same in both expressions that are added together, it will match the longest sub-expression that is the same. Thus, we modify replacementRule as

replacementRule = Plus[
  Dot[Longest[FRONT__], AA__, BACK__]
  , Dot[FRONT__, BB__, BACK__]
 ] :> Dot[FRONT, Plus[Dot[AA], Dot[BB]], BACK]}]

in which case

w.g.a.b.r + w.g.c.d.r /. replacementRule

yields

(* w.g.(a.b + c.d).r *)

Note that we don't need to modify the pattern as written to rewrite w.g.a.b.f.r + w.g.c.d.f.r as w.g.(a.b + c.d).f.r since, again, the pattern-matching matches the longest expression it can starting from the end of the list.

Answer 2

It can be done with

w.a.b.r + w.c.d.r /. 
  Dot[FRONT_, AA__, BACK_] + Dot[FRONT_, BB__, BACK_] :> 
    Dot[FRONT, Dot[AA] + Dot[BB], BACK]

w.(a.b + c.d).r

However, I like function argument destructuring, so I would probably write

f[Dot[w_, a__, r_] + Dot[w_, b__, r_]] := w.(Dot[a] + Dot[b]).r
f[w.a.b.r + w.c.d.r]

w.(a.b + c.d).r