2
$\begingroup$

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?

$\endgroup$
  • $\begingroup$ 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]]} ? $\endgroup$ – rhermans Nov 6 '15 at 0:53
  • $\begingroup$ @rhermans I tried that, it doesn't make a difference. $\endgroup$ – Alex Mathers Nov 6 '15 at 1:06
  • 2
    $\begingroup$ Please use a title that describes your problem!!! $\endgroup$ – David G. Stork Nov 6 '15 at 1:10
  • 1
    $\begingroup$ 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}] . $\endgroup$ – Eric Towers Nov 6 '15 at 1:23
  • $\begingroup$ Any pair of elements. So for your example the output would ideally be p[{1,2,3,5,6}] p[{4}] $\endgroup$ – Alex Mathers Nov 6 '15 at 1:34
4
$\begingroup$

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

In[1]:= 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[1]= p[{1, 2, 3, 4, 5, 6}]
$\endgroup$
  • $\begingroup$ Ha! before, between, after sounds funny :) $\endgroup$ – Dr. belisarius Nov 6 '15 at 2:15
  • $\begingroup$ This worked! Thank you. $\endgroup$ – Alex Mathers Nov 6 '15 at 3:28
6
$\begingroup$

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.

$\endgroup$
  • $\begingroup$ This does immensely! Thank you!! $\endgroup$ – Alex Mathers Nov 6 '15 at 1:35
  • $\begingroup$ 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? $\endgroup$ – Alex Mathers Nov 6 '15 at 1:58
  • $\begingroup$ In a new notebook run ClearAll[p, list1, list2, rep] and then the code above. $\endgroup$ – Edmund Nov 6 '15 at 2:00
  • $\begingroup$ Same problem. The first just returns p[{3,4}] p[{5,6}] p[{1,4,6}] p[{2,3,5}] $\endgroup$ – Alex Mathers Nov 6 '15 at 2:22
  • $\begingroup$ so this works for you when you enter it? I'm assuming it's just something wrong with my setup. $\endgroup$ – Alex Mathers Nov 6 '15 at 2:32

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.