7
$\begingroup$

Consider the following example set

set = { {a,{1,2,3}} , {b,{1}} , {c,{2,3}} , {d,{4,5}} , {e,{5}} };

I would like to have a function (lets call it magic[x_]) that looks at the lists set[[i,2]] and groups the elements i of set into new sets such as to separate disjoint lists. For example:

magic[set]

{ { {a,{1,2,3}} , {b,{1}} , {c,{2,3}} } , { {d,{4,5}} , {e,{5}} } }

which grouped elemets containing lists with overlapping entries {1,2,3} and {4,5} but each disjoint from one another. Is there a function in Mathematica which can be used to achieve that? Or maybe this can be implemented conveniently? Thanks for any suggestion!

Improve this question
$\endgroup$
7
  • 2
    $\begingroup$ I'm not sure I understand what you want exactly, but does this work? Gather[set, IntersectingQ[#1[[2]], #2[[2]]] &]. It works for your example, but does it work for more general sets? $\endgroup$ Commented Feb 9, 2017 at 18:54
  • $\begingroup$ Wow, yes this works! I did not expect it to be this simple. Just out of curiosity, how do you think would one implement it if it had to be done in a more low level programming language? $\endgroup$ Commented Feb 9, 2017 at 18:57
  • 1
    $\begingroup$ That's a question for Stackoverflow. $\endgroup$ Commented Feb 9, 2017 at 19:00
  • $\begingroup$ @Feyre oh, ok, I understand. $\endgroup$ Commented Feb 9, 2017 at 19:01
  • 1
    $\begingroup$ @Kagaratsch To implement connected components directly, using Mathematica, see the first link here. $\endgroup$ Commented Feb 9, 2017 at 19:56

2 Answers 2

Reset to default
8
$\begingroup$

"Overlapping" is not an equivalence relationship because it is not transitive. So approaches using Gather and related functions are not possible.

The simplest, though not the most efficient way is to test every pair of elements from the set. After doing that, we can treat this as a ConnectedComponents problem.

Code:

set = {{a, {1, 2, 3}}, {b, {1}}, {c, {2, 3}}, {d, {4, 5}}, {e, {5}}};

am = Outer[Boole@IntersectingQ[#1[[2]], #2[[2]]] &, set, set, 1]
(* {{1, 1, 1, 0, 0}, {1, 1, 0, 0, 0}, {1, 0, 1, 0, 0}, {0, 0, 0, 1, 1}, {0, 0, 0, 1, 1}} *)

components = ConnectedComponents@AdjacencyGraph[am]
(* {{1, 2, 3}, {4, 5}} *)

Part[set, #] & /@ components
(* {{{a, {1, 2, 3}}, {b, {1}}, {c, {2, 3}}}, {{d, {4, 5}}, {e, {5}}}} *)

Addendum

This is what could happen if we try to use Gather anyway:

sets = Partition[Range[5], 2, 1]
(* {{1, 2}, {2, 3}, {3, 4}, {4, 5}} *)

Gather[sets, IntersectingQ]
(* { {{1, 2}, {2, 3}}, 
     {{3, 4}, {4, 5}} } *)
Improve this answer
$\endgroup$
3
  • $\begingroup$ I suspected something of this sort. Is there an obvious example for which the simple Gather[set, IntersectingQ[#1[[2]], #2[[2]]] &] doesn't work? (And as a side note, you imply that Gather assumes transitivity, which means that it does not test every pair? Rather, I imagine it basically makes the sublists on the fly, and for each new check, it just checks to see if one of the elements already in the sublist matches with the new element. Is this correct?) $\endgroup$ Commented Feb 9, 2017 at 19:54
  • $\begingroup$ @march I think that is correct, see edit. $\endgroup$ Commented Feb 9, 2017 at 19:58
  • $\begingroup$ Thanks for the update. That's an important thing that definitely passed me by. $\endgroup$ Commented Feb 10, 2017 at 18:47
2
$\begingroup$ 
ConnectedComponents @ SimpleGraph @ RelationGraph[IntersectingQ @@ {##}[[All, 2]]&, set]

{{{a, {1, 2, 3}}, {b, {1}}, {c, {2, 3}}},
{{d, {4, 5}}, {e, {5}}}}

Improve this answer
$\endgroup$

Your Answer

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

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.