Replacement rule not having desired effect

So I have this replacement rule that tends to work in most cases, except occasionally in cases like this:

p[{3, 4}] p[{5, 6}] p[{1, 4, 6}] p[{2, 3, 5}] //.
{p[list1_] p[list2_] :>
If[Length[Intersection[list1, list2]] != 0, p[Union[list1, list2]]]}

the problem seems to be that every time it evaluates the replacement rule, it only looks at the first two terms. If there's no replacement to be done it then just doesn't do anything. Does anybody know a way to maybe "scramble" the terms in the list or make the replacement look at every part of the expression?

• You need a case when If evaluates to False, probably p[{3, 4}] p[{5, 6}] p[{1, 4, 6}] p[{2, 3, 5}] //. {p[list1_] p[list2_] -> If[Length[Intersection[list1, list2]] != 0, p[Union[list1, list2]], p[list1] p[list2]]} ? Nov 6 '15 at 0:53
• @rhermans I tried that, it doesn't make a difference. Nov 6 '15 at 1:06
• Please use a title that describes your problem!!! Nov 6 '15 at 1:10
• Do you only want to merge the lists from neighbouring elements of the product or any pair of elements of the product? (@belisariusisforth is right that Orderless is going to make "neighbouring" somewhat slippery.) Consider p[{1,2}] p[{2,3}] p[{4}] p[{5,6}] p[{6,1}] . Nov 6 '15 at 1:23
• Any pair of elements. So for your example the output would ideally be p[{1,2,3,5,6}] p[{4}] Nov 6 '15 at 1:34

One way to do it is to make sure you allow for other terms that aren't part of the match, like so:

In:= p[{3, 4}] p[{5, 6}] p[{1, 4, 6}] p[{2, 3, 5}] //.
Times[before___p, p[l1_List], between___p, p[l2_List], after___p] /;
Intersection[l1, l2] =!= {} :>
Times[p[Union[l1, l2]], before, between, after]
Out= p[{1, 2, 3, 4, 5, 6}]
• Ha! before, between, after sounds funny :) Nov 6 '15 at 2:15
• This worked! Thank you. Nov 6 '15 at 3:28

You can condition your pattern match with ContainsAny.

rep = {p[list1_] p[list2_] /; ContainsAny[list1, list2] :> p[Union[list1, list2]]};

p[{3, 4}] p[{5, 6}] p[{1, 4, 6}] p[{2, 3, 5}] //. rep
(* p[{1, 2, 3, 4, 5, 6}] *)

p[{3, 4}] p[{5, 6}] p[{8, 10}] p[{1, 4, 6}] p[{2, 3, 5}] //. rep
(* p[{8, 10}] p[{1, 2, 3, 4, 5, 6}] *)

Hope this helps.

• This does immensely! Thank you!! Nov 6 '15 at 1:35
• this actually doesn't seem to work how it should. Even if I input the example you give it doesn't change it. Do you know what the problem might be? Nov 6 '15 at 1:58
• In a new notebook run ClearAll[p, list1, list2, rep] and then the code above. Nov 6 '15 at 2:00
• Same problem. The first just returns p[{3,4}] p[{5,6}] p[{1,4,6}] p[{2,3,5}] Nov 6 '15 at 2:22
• so this works for you when you enter it? I'm assuming it's just something wrong with my setup. Nov 6 '15 at 2:32