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?

Improve this question
$\endgroup$

3 Answers 3

Reset to default
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}}}

 *)
Improve this answer
$\endgroup$
4
  • $\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
    Commented Mar 5, 2014 at 1:49
  • $\begingroup$ Yep, that's totally what I meant. My output is wrong, I'll fix it. $\endgroup$
    – xtian777x
    Commented Mar 5, 2014 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
    Commented Mar 5, 2014 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
    Commented Mar 5, 2014 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}}} *)
Improve this answer
$\endgroup$
0
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}}}
*)
Improve this answer
$\endgroup$
9
  • $\begingroup$ Noooooooo! I considered this, but... ReplaceRepeated + multiple BlankNullSequence == kaboom! :D $\endgroup$
    – rm -rf ♦
    Commented Mar 5, 2014 at 2:30
  • $\begingroup$ @rm-rf Yep, You preferred copy-pasting Heike's answer. I know $\endgroup$
    – Dr. belisarius
    Commented Mar 5, 2014 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 ♦
    Commented Mar 5, 2014 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
    Commented Mar 5, 2014 at 2:33
  • $\begingroup$ @belisarius Are we having a battle of whose old notebook has the worst code? Bring it on! $\endgroup$
    – rm -rf ♦
    Commented Mar 5, 2014 at 2:34

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.