The issue in your rule is that a_ and b_ don't necessarily need to be symbols. What if your a matches a larger portion of the expression?
OrderedQ[{(Com[p2, p1] + p1 ** p2), p1}]
(* False *)
Then the rule would be applied and I'm not sure this your intention. Please try this set of rules. I have added some print commands so that you see which rule was applied:
r = {
a_Symbol ** b_Symbol /; ! OrderedQ[{a, b}] :> (Print["R1"];
Com[a, b] + b ** a),
(e1_ + e2_) ** e3_ :> (Print["R2"]; e1 ** e3 + e2 ** e3),
e3_ ** (e1_ + e2_) :> (Print["R3"]; e3 ** e1 + e3 ** e2)
}
s ** p1 ** p1 ** p2 - s ** p1 ** p2 ** p1 //. r
(* -Com[s, p1] ** Com[p2, p1] - p1 ** s ** Com[p2, p1] *)
If Com[p2,p1] is zero, then the above expression vanishes.
You made a comment
mathematica can't reduce mostly the same expression:
f[x1] ** p2 + g[x1] ** p1 ** p1 ** p2 - g[x1] ** p1 ** p2 ** p1 //. r
Yes, that's because I only allowed the rule to apply if the a_ and b_ are symbols. f[x1] is not a symbol. It is an expression with the head f.
The big catch here is the following: An expression like x+y is basically of the same type as f[x1]. It is Plus[x,y] and now let's assume you have to following:
z ** (x + y)
As you can check easily, OrderedQ[{z, (x + y)}] is False and therefore, your rule would apply which would result in
z ** (x + y) /. a_ ** b_ :> Com[a, b] + b ** a
(* Com[z, x + y] + (x + y) ** z *)
I thought that this is not what you want. Therefore, I explicitly forced the a and b in the replacement rule to be symbols. But this will lead to exactly the situation you have found, where f[x1] is not simplified.