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

| improve this answer | |
$\endgroup$
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}}
| improve this answer | |
$\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.