# Sorting a Collection of Lists by Comparing Different Parts

I am looking for a way to use Sort[] to sort a collection of lists by comparing different parts of these lists. For example, sorting by comparing the second part of one list with the first part of another.

More specifically, given the list

list={{1, 4}, {2, 7}, {4, 6}, {5, 2}, {6, 5}, {7, 1}}


I would like to use Sort[] to sort list such that list[[1,2]] equals list[[2,1]], list[[2,2]] equals list[[3,1]], etc. giving output

{{1, 4}, {4, 6}, {6, 5}, {5, 2}, {2, 7}, {7, 1}}


I tried

Sort[list, (#1[[2]] == #2[[1]]) &]


but the output is

{{2, 7}, {7, 1}, {6, 5}, {5, 2}, {1, 4}, {4, 6}}


Repeatedly applying this sort function using Nest or FixedPoint did not give the output I wanted either.

Notice this problem is more general, as replacing == with < or > in my sort function does not sort the way one would expect either.

Though I know of ways to do this, I am looking for a nice, fast way, preferably using Sort.

• Does this work? Reverse@Partition[Sort[list, (#1[[2]] == #2[[1]]) &], 2]~Flatten~1 Commented Jan 30, 2020 at 19:08
• Alternatively, I think this would work? Partition[FindHamiltonianPath[DirectedEdge @@@ list], 2, 1, 1]. Let me know if these suggestions work for you generally (i.e. try it on more complicated examples), and if so, I can write an answer. Commented Jan 30, 2020 at 19:12
• @march No, your first function does not. It happens to work for the example I gave above, but given list={{1, 2}, {2, 5}, {3, 1}, {5, 7}, {6, 3}, {7, 6}} your function outputs {{1, 2}, {2, 5}, {7, 6}, {3, 1}, {6, 3}, {5, 7}} when it should give {{1, 2}, {2, 5}, {5, 7}, {7, 6}, {6, 3}, {3, 1}}. Commented Jan 30, 2020 at 19:13
• Yeah, it was definitely a kluge. I'm willing to bet that the second one should work in general, though, and if it doesn't, then I suspect the problem is ill-posed (i.e. there is more than one solution to your problem). Let me know! Commented Jan 30, 2020 at 19:14
• Here's a better version of the 2nd one: List @@@ First@FindHamiltonianCycle[UndirectedEdge @@@ list]. Commented Jan 30, 2020 at 19:16

lst1 = {{1, 4}, {2, 7}, {4, 6}, {5, 2}, {6, 5}, {7, 1}};
lst2 = {{1, 2}, {2, 5}, {3, 1}, {5, 7}, {6, 3}, {7, 6}};


1. An alternative method using FindCycle and RelationGraph:

ClearAll[findCycl1]
findCycl1 =  FindCycle[RelationGraph[#[[2]] == #2[[1]] &, # ]][[1, ;; , 1]] &;

findCycl1 /@ {lst1, lst2}


{{{1, 4}, {4, 6}, {6, 5}, {5, 2}, {2, 7}, {7, 1}},
{{1, 2}, {2, 5}, {5, 7}, {7, 6}, {6, 3}, {3, 1}}}

2. Recursive replacement with FixedPoint:

ClearAll[step, findCycl2]
step[p : {__, {}}] := p
step[{p1___, {a_, b_}, {d___, {b_, c_}, e___}}] := {p1, {a, b}, {b, c}, {d, e}}
findCycl2 = Most @ FixedPoint[step, {First @ #, Rest @ #}] &;

findCycl2 /@ {lst1, lst2}


{{{1, 4}, {4, 6}, {6, 5}, {5, 2}, {2, 7}, {7, 1}},
{{1, 2}, {2, 5}, {5, 7}, {7, 6}, {6, 3}, {3, 1}}}

3. Using step with NestWhile

ClearAll[findCycl3]
findCycl3 = Most @ NestWhile[step, {First@#, Rest@#}, Last[#] != {} &] &;
findCycl3 /@ {lst1, lst2}


{{{1, 4}, {4, 6}, {6, 5}, {5, 2}, {2, 7}, {7, 1}},
{{1, 2}, {2, 5}, {5, 7}, {7, 6}, {6, 3}, {3, 1}}}

• I like the FixedPoint[] solution. :) Commented Jan 31, 2020 at 16:16

Using march's general idea to treat the pairs as a list of graph edges:

List @@@ First[FindCycle[Rule @@@ {{1, 4}, {2, 7}, {4, 6}, {5, 2}, {6, 5}, {7, 1}}]]
{{1, 4}, {4, 6}, {6, 5}, {5, 2}, {2, 7}, {7, 1}}

List @@@ First[FindCycle[Rule @@@ {{1, 2}, {2, 5}, {3, 1}, {5, 7}, {6, 3}, {7, 6}}]]
{{1, 2}, {2, 5}, {5, 7}, {7, 6}, {6, 3}, {3, 1}}