2
$\begingroup$

The following code sort the list li in a such way that consecutive terms $t_n,t_{n+1}$ are of the from ...{x_,y_}, {y_,z_}.... i.e. $first(t_{n+1})=last(t_{n})$

I suspect there may be a nicer code that would use one of these: FoldList, NestList or other iterative functions. (or maybe some of the functions used on graphs like FindPath)

I just cannot figure out how to do it.

Input:

li = {{102, 101}, {5, 6}, {69, 82}, {111, 110}, {48, 35}, {92, 
    79}, {94, 95}, {72, 59}, {152, 165}, {112, 113}, {7, 20}, {88, 
    75}, {53, 40}, {8, 7}, {11, 24}, {109, 96}, {116, 115}, {29, 
    42}, {58, 57}, {2, 15}, {51, 50}, {47, 60}, {120, 107}, {166, 
    167}, {15, 16}, {73, 86}, {9, 8}, {12, 11}, {82, 81}, {70, 
    71}, {133, 132}, {56, 69}, {57, 56}, {125, 124}, {149, 148}, {27, 
    14}, {14, 1}, {165, 166}, {68, 55}, {128, 129}, {19, 32}, {40, 
    41}, {96, 97}, {39, 26}, {18, 5}, {49, 48}, {157, 144}, {20, 
    21}, {135, 134}, {137, 138}, {75, 62}, {139, 140}, {99, 112}, {34,
     33}, {97, 98}, {17, 18}, {81, 68}, {43, 44}, {64, 65}, {54, 
    67}, {90, 91}, {105, 92}, {145, 146}, {146, 159}, {160, 
    161}, {167, 168}, {85, 84}, {158, 157}, {148, 147}, {151, 
    150}, {98, 85}, {31, 30}, {86, 87}, {130, 117}, {1, 2}, {13, 
    12}, {140, 153}, {132, 145}, {115, 102}, {143, 130}, {113, 
    114}, {168, 169}, {159, 158}, {4, 17}, {16, 3}, {44, 45}, {101, 
    88}, {142, 143}, {108, 121}, {21, 34}, {136, 135}, {25, 38}, {74, 
    73}, {91, 78}, {63, 76}, {52, 39}, {119, 120}, {23, 10}, {164, 
    151}, {41, 28}, {78, 77}, {6, 19}, {10, 9}, {138, 139}, {134, 
    133}, {131, 118}, {22, 23}, {117, 104}, {147, 160}, {155, 
    154}, {37, 36}, {83, 70}, {60, 61}, {153, 152}, {87, 100}, {59, 
    58}, {24, 25}, {106, 105}, {118, 119}, {42, 43}, {38, 51}, {129, 
    142}, {67, 66}, {89, 90}, {127, 126}, {163, 164}, {50, 37}, {126, 
    125}, {100, 99}, {154, 141}, {150, 137}, {32, 31}, {71, 72}, {114,
     127}, {46, 47}, {77, 64}, {79, 80}, {162, 163}, {65, 52}, {55, 
    54}, {76, 89}, {28, 27}, {161, 162}, {3, 4}, {62, 63}, {123, 
    136}, {156, 155}, {144, 131}, {35, 22}, {122, 109}, {103, 
    116}, {107, 106}, {95, 108}, {80, 93}, {61, 74}, {110, 123}, {33, 
    46}, {141, 128}, {169, 156}, {121, 122}, {66, 53}, {30, 29}, {104,
     103}, {26, 13}, {93, 94}, {36, 49}, {124, 111}, {84, 83}};
start = {{149, 148}};
Table[start = Join[start, Cases[li, {start[[-1, -1]], x_}]], {i, 
   300}][[-1]]

Output:

{{149, 148}, {148, 147}, {147, 160}, {160, 161}, {161, 162}, {162, 
  163}, {163, 164}, {164, 151}, {151, 150}, {150, 137}, {137, 
  138}, {138, 139}, {139, 140}, {140, 153}, {153, 152}, {152, 
  165}, {165, 166}, {166, 167}, {167, 168}, {168, 169}, {169, 
  156}, {156, 155}, {155, 154}, {154, 141}, {141, 128}, {128, 
  129}, {129, 142}, {142, 143}, {143, 130}, {130, 117}, {117, 
  104}, {104, 103}, {103, 116}, {116, 115}, {115, 102}, {102, 
  101}, {101, 88}, {88, 75}, {75, 62}, {62, 63}, {63, 76}, {76, 
  89}, {89, 90}, {90, 91}, {91, 78}, {78, 77}, {77, 64}, {64, 
  65}, {65, 52}, {52, 39}, {39, 26}, {26, 13}, {13, 12}, {12, 
  11}, {11, 24}, {24, 25}, {25, 38}, {38, 51}, {51, 50}, {50, 
  37}, {37, 36}, {36, 49}, {49, 48}, {48, 35}, {35, 22}, {22, 
  23}, {23, 10}, {10, 9}, {9, 8}, {8, 7}, {7, 20}, {20, 21}, {21, 
  34}, {34, 33}, {33, 46}, {46, 47}, {47, 60}, {60, 61}, {61, 
  74}, {74, 73}, {73, 86}, {86, 87}, {87, 100}, {100, 99}, {99, 
  112}, {112, 113}, {113, 114}, {114, 127}, {127, 126}, {126, 
  125}, {125, 124}, {124, 111}, {111, 110}, {110, 123}, {123, 
  136}, {136, 135}, {135, 134}, {134, 133}, {133, 132}, {132, 
  145}, {145, 146}, {146, 159}, {159, 158}, {158, 157}, {157, 
  144}, {144, 131}, {131, 118}, {118, 119}, {119, 120}, {120, 
  107}, {107, 106}, {106, 105}, {105, 92}, {92, 79}, {79, 80}, {80, 
  93}, {93, 94}, {94, 95}, {95, 108}, {108, 121}, {121, 122}, {122, 
  109}, {109, 96}, {96, 97}, {97, 98}, {98, 85}, {85, 84}, {84, 
  83}, {83, 70}, {70, 71}, {71, 72}, {72, 59}, {59, 58}, {58, 
  57}, {57, 56}, {56, 69}, {69, 82}, {82, 81}, {81, 68}, {68, 
  55}, {55, 54}, {54, 67}, {67, 66}, {66, 53}, {53, 40}, {40, 
  41}, {41, 28}, {28, 27}, {27, 14}, {14, 1}, {1, 2}, {2, 15}, {15, 
  16}, {16, 3}, {3, 4}, {4, 17}, {17, 18}, {18, 5}, {5, 6}, {6, 
  19}, {19, 32}, {32, 31}, {31, 30}, {30, 29}, {29, 42}, {42, 
  43}, {43, 44}, {44, 45}}

Update:

Or if you want to test the code on a random list li:

origli = Partition[RandomSample[Range[100]], 2, 1];
li = RandomSample[origli]
pstart = (Reverse /@ Tally[Flatten[%]] // Sort)[[{1, 2}, 2]];
start = Cases[li, {Alternatives @@ pstart, x_}];
sortedli = 
 Table[start = Join[start, Cases[li, {start[[-1, -1]], x_}]], {i, 
    300}][[-1]]
sortedli == origli
Clear[origli, li, pstart, start, sortedli]
$\endgroup$
3
  • $\begingroup$ E.g. with patterns: rule = {x1___, y1 : {, x3}, x4__, y2 : {x3_, }, x5__} :> {x1, y1, y2, x4, x5}; li //. rule $\endgroup$ Oct 28, 2020 at 13:23
  • $\begingroup$ It does not seem to work... Is there a typo? Or what version of Mathematica are you using? $\endgroup$ Oct 28, 2020 at 13:29
  • $\begingroup$ The stack exchange editor changes the pattern. I will put it in the answer window. $\endgroup$ Oct 28, 2020 at 13:48

2 Answers 2

4
$\begingroup$

1. TopologicalSort

path1 = Partition[TopologicalSort[DirectedEdge @@@ li], 2, 1]

![enter image description here

2. FindHamiltonianPath

path2 = Partition[Reverse @ FindHamiltonianPath[li], 2, 1];

Alternatively,

path3  = Partition[FindHamiltonianPath[DirectedEdge @@@ li], 2, 1];

3. RelationGraph

rg = RelationGraph[#[[2]] == #2[[1]] &, li]

path4 = FindHamiltonianPath @ rg ;

We can use rg in several additional ways to get the desired list:

root = First @ VertexList[rg, _?(VertexInDegree[rg, #] == 0 &)]; 

path5 = VertexOutComponent[rg, root];

path6 =  SortBy[GraphDistance[rg, root, #] &] @ VertexList[rg];

path7 = SortBy[Length[VertexInComponent[rg, {#}]] &] @ VertexList[rg];

4. Nest

ClearAll[firstPair, nextPair, addPair]
firstPair[pairs_] := FirstCase[pairs, {a_, b_} /; Count[pairs, {_, a}] == 0]
nextPair[pairs_][{a_, b_}] := FirstCase[{b, _}]@pairs
addPair[pairs_][{a___, b_}] := {a, b, nextPair[pairs][b]}

path8 = Nest[addPair[li], {firstPair[li]}, Length @ li - 1];

5. FixedPoint + SequenceReplace

path9 = FixedPoint[SequenceReplace[{{a_, b_}, c___, {b_, d_}} | {{b_, d_}, 
     c___, {a_, b_}} :> Sequence[{a, b}, {b, d}, c]], li];

path1 == path2 == path3 == path4 == path5 == path6 == path7 == path8 == path9
 True
$\endgroup$
2
  • $\begingroup$ Almost perfect... but it finds ...{x_,y_}, {y_,z_}... or ...{y_,x_}, {z_,y_}.... it depends on the order of GraphPeriphery whether FindPath works on {{149, 148}, {44, 45}} or on {{44, 45},{149, 148}} $\endgroup$ Oct 28, 2020 at 14:46
  • $\begingroup$ @azerbajdzan, please see the new version. $\endgroup$
    – kglr
    Oct 28, 2020 at 16:32
0
$\begingroup$
rule = {x1___, y1 : {_, x3_}, x4__, y2 : {x3_, _}, x5___} :> {x1, y1, 
   y2, x4, x5}; 
Sort[li] //. rule
$\endgroup$
10
  • $\begingroup$ Still does not work. Because it produces such results as for example: ...{94, 57}, {57, 9}, {99, 23}, {23, 65}, {65, 67}.... But 9 and 99 are not the same. $\endgroup$ Oct 28, 2020 at 13:55
  • $\begingroup$ Even weirder one: ...{7, 25}, {25, 3}, {3, 85}, {44, 96}, {96, 11}, {11, 33}.... 85 and 44 are no the same. $\endgroup$ Oct 28, 2020 at 13:59
  • 1
    $\begingroup$ I do not think this answer deserved a down vote. It sort the list almost as required but not entire list. It is like it sort it by several chunks. Maybe it can be fixed. $\endgroup$ Oct 28, 2020 at 14:14
  • $\begingroup$ What data are you using. I can't see what you say. $\endgroup$ Oct 28, 2020 at 20:31
  • $\begingroup$ You can use it on original li list or random li that is in the update. $\endgroup$ Oct 28, 2020 at 20:40

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.