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 '20 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 '20 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$ – Just Some Old Man Jan 30 '20 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 '20 at 19:14
  • 2
    $\begingroup$ Here's a better version of the 2nd one: List @@@ First@FindHamiltonianCycle[UndirectedEdge @@@ list]. $\endgroup$ – march Jan 30 '20 at 19:16
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$ – J. M.'s ennui Jan 31 '20 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, privacy policy and cookie policy

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