2
$\begingroup$

I have a first list of pairs like this one:

list1= {{1, 2}, {3, 4}, {5, 6}, {7, 8}, {9, 10}, {11, 12}, {13, 14}, {15, 16}, {17, 18}, {19, 20}, {21, 22}, {23, 24}, {25, 26}, {27, 28}, {29, 30}, {31, 32}, {33, 34}, {35, 36}, {37, 38}, {39, 40}, {41, 42}, {43, 44}, {45, 46}, {47, 48}, {49, 50}}

And a second one containing information about how the elements of the first list are related:

list2 = {{1, 46}, {5, 27}, {8, 42}, {21, 26, 29}, {31, 45}, {33, 36}, {35, 37}, {47, 49}}

How can I gather elements of the first list using list2 as a reference to get groups like these:

{{{1, 2}, {45, 46}, {31, 32}}, {{5, 6}, {27, 28}}, {{7, 8}, {41, 42}}, {{21, 22}, {25, 26}, {29, 30}}, {{31, 32}, {45, 46}}, {{33, 34}, {35, 36}, {37, 38}}, {{47, 48}, {49, 50}}}

So what it's happening here is that, element {1, 46} of list2 is telling that the pair containing element "1" ({1, 2}) of list1 is linked to element containing element "46" ({45, 46}) and so on.

Note that when you use list 2 element {35, 37} to gather {{35, 36}, {37, 38}} you should consider that list 2 element {33, 36} already linked {{33, 34}, {35, 36}} so you will have a three element group {{33, 34}, {35, 36}, {37, 38}}.

I tried to use graph related functions but couldn't make it work. Any ideas?

$\endgroup$
5
$\begingroup$

If I understand your question correctly,

dp = Dispatch@Flatten[{#1 -> {##}, #2 -> {##}} & @@@ list1]

list2 = Sequence @@ Partition[#, 2, 1] & /@ list2

ConnectedComponents@Graph@Union[Sort /@ UndirectedEdge @@@ (list2 /. dp)]

(* ==>

{{{31, 32}, {45, 46}, {1, 2}}, {{21, 22}, {25, 26}, {29, 30}}, {{37, 
   38}, {35, 36}, {33, 34}}, {{41, 42}, {7, 8}}, {{5, 6}, {27, 
   28}}, {{49, 50}, {47, 48}}}

 *)
$\endgroup$
  • $\begingroup$ This is not the same output you quote. Please check if there's a mistake in the output you posted or whether I misunderstood the question. $\endgroup$ – Szabolcs Mar 5 '14 at 1:49
  • $\begingroup$ Yep, that's totally what I meant. My output is wrong, I'll fix it. $\endgroup$ – xtian777x Mar 5 '14 at 1:57
  • $\begingroup$ @xtian777x Don't be too quick to accept! My code was wrong ;-) I didn't notice the 3-element list in list2. It's fixed now. But it's not pretty. You might consider waiting for a prettier solution :) $\endgroup$ – Szabolcs Mar 5 '14 at 2:00
  • $\begingroup$ Yeah I was coming here to post the error I got. Thanx a lot, that'll work for now. My solution was not even close to be pretty. $\endgroup$ – xtian777x Mar 5 '14 at 2:07
2
$\begingroup$

Here's a direct list-manipulation approach using a variation of Heike's answer for combining subsets with similar terms:

Cases[list1, {___, Alternatives @@ #, ___}, 2] & /@ list2 //. 
    x_ :> Union @@@ Gather[x, Intersection@## =!= {} &]

(* {{{1, 2}, {31, 32}, {45, 46}}, {{5, 6}, {27, 28}}, {{7, 8}, {41, 42}}, 
    {{21, 22}, {25, 26}, {29, 30}}, {{33, 34}, {35, 36}, {37, 38}}, {{47, 48}, {49, 50}}} *)
$\endgroup$
2
$\begingroup$
c = Cases[list1, {x_,  y_} /; (MatchQ[x, Alternatives @@ #] || 
                               MatchQ[y, Alternatives @@ #]) :> {x, y}] & /@ list2

c //. {x___, {a___, y__, b___}, p___, {c___, y__, d___},  z___} :> {x, {a, y, b, c, d}, p, z}

(*
 {{{1, 2}, {45, 46}, {31, 32}}, 
  {{5, 6}, {27, 28}}, 
  {{7, 8}, {41, 42}}, 
  {{21, 22}, {25, 26}, {29, 30}}, 
  {{33, 34}, {35, 36}, {37, 38}}, 
  {{47, 48}, {49, 50}}}
*)
$\endgroup$
  • $\begingroup$ Noooooooo! I considered this, but... ReplaceRepeated + multiple BlankNullSequence == kaboom! :D $\endgroup$ – rm -rf Mar 5 '14 at 2:30
  • $\begingroup$ @rm-rf Yep, You preferred copy-pasting Heike's answer. I know $\endgroup$ – Dr. belisarius Mar 5 '14 at 2:30
  • $\begingroup$ The joke's still on you buddy, since you copy-pasted my answer =) I'll have a Tantō ready for you. $\endgroup$ – rm -rf Mar 5 '14 at 2:32
  • $\begingroup$ @rm-rf I'm sure I've an older one of mine to cite with the same bad trick $\endgroup$ – Dr. belisarius Mar 5 '14 at 2:33
  • $\begingroup$ @belisarius Are we having a battle of whose old notebook has the worst code? Bring it on! $\endgroup$ – rm -rf Mar 5 '14 at 2:34

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.