3
$\begingroup$

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.

$\endgroup$
7
  • $\begingroup$ Does this work? Reverse@Partition[Sort[list, (#1[[2]] == #2[[1]]) &], 2]~Flatten~1 $\endgroup$
    – march
    Jan 30, 2020 at 19:08
  • $\begingroup$ 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. $\endgroup$
    – march
    Jan 30, 2020 at 19:12
  • $\begingroup$ @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}}. $\endgroup$ Jan 30, 2020 at 19:13
  • $\begingroup$ 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! $\endgroup$
    – march
    Jan 30, 2020 at 19:14
  • 2
    $\begingroup$ Here's a better version of the 2nd one: List @@@ First@FindHamiltonianCycle[UndirectedEdge @@@ list]. $\endgroup$
    – march
    Jan 30, 2020 at 19:16

2 Answers 2

3
$\begingroup$
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}}}

$\endgroup$
1
  • 1
    $\begingroup$ I like the FixedPoint[] solution. :) $\endgroup$ Jan 31, 2020 at 16:16
1
$\begingroup$

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}}
$\endgroup$

Your Answer

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

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