3
$\begingroup$

I have this list

list={{0,7},{16,0},{16,2},{12,5},{11,1},{1,20},{3,20}};

This is my current method to realize it.

ConnectedComponents@RelationGraph[IntersectingQ, list]

{{{16, 2}, {16, 0}, {0, 7}}, {{11, 1}, {1, 20}, {3, 20}}, {{12, 5}}}

But are there non-graph and concise solution can implement this target?

$\endgroup$

2 Answers 2

1
$\begingroup$
list = {{0, 7}, {16, 0}, {16, 2}, {12, 5}, {11, 1}, {1, 20}, {3, 20}};

EdgeList /@ ConnectedGraphComponents@
   Graph[UndirectedEdge @@@ list] /.
 UndirectedEdge -> List

(*  {{{16, 2}, {16, 0}, {0, 7}}, {{11, 1}, {1, 20}, {3, 20}}, {{12, 5}}}  *)

Very slightly shorter,

Apply[List,
 EdgeList /@ ConnectedGraphComponents@
   Graph[UndirectedEdge @@@ list], {2}]

(*  {{{16, 2}, {16, 0}, {0, 7}}, {{11, 1}, {1, 20}, {3, 20}}, {{12, 5}}}  *)

% === %%

(*  True  *)

Without using any Graph functions you can get equivalent (graphs are undirected) but differently ordered results.

list = {{0, 7}, {16, 0}, {16, 2}, {12, 5}, {11, 1}, {1, 20}, {3, 20}};

Partition[#, 2, 
   1] & /@ (list //. {{s___, {x1_, i1___, y1_}, m___, {y1_, i2___, y2_}, 
      e___} :>
     {s, {x1, i1, y1, i2, y2}, m, e},
    {s___, {x1_, i1___, y1_}, m___, {x2_, i2___, x1_}, e___} :>
     {s, {x2, i2, x1, i1, y1}, m, e},
    {s___, {x1_, i1___, y1_}, m___, {x1_, i2___, y2_}, e___} :>
     {s, {y2, Sequence@Reverse@{i2}, x1, i1, y1}, m, e},
    {s___, {x1_, i1___, y1_}, m___, {x2_, i2___, y1_}, e___} :>
     {s, {x1, i1, y1, Sequence@Reverse@{i2}, x2}, m, e}, {} :> Nothing})

(*  {{{2, 16}, {16, 0}, {0, 7}}, {{12, 5}}, {{11, 1}, {1, 20}, {20, 3}}}  *)
$\endgroup$
1
  • $\begingroup$ Thinks for your concerning.But so many pattern is hard to understand for me.:)And I have a new thinking about it,I'll post it later. $\endgroup$
    – yode
    Commented May 31, 2016 at 1:35
1
$\begingroup$

The code is ugly,I don't like the If here especially,anyway it works.:)

list = {{0, 7}, {16, 0}, {16, 2}, {12, 5}, {11, 1}, {1, 20}, {3, 20}};
FixedPoint[
 Function[l, temp = Gather[l, ContainsAny[Flatten@#, Flatten[#2]] &]; 
  If[Depth[temp] > 4, Catenate/@temp, temp]], list]

{{{0, 7}, {16, 0}, {16, 2}}, {{12, 5}}, {{11, 1}, {1, 20}, {3, 20}}}

$\endgroup$

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.