# Rearranging a List

I am trying to rearrange/sort a list i.e.

 {{1,2},{10,140},{43,10},{1,140},{43,2}}


into

 {{1,2},{2,43},{43,10},{10,140},{140,1}}


or any cyclic permutation of it. The numbers don't repeat more than twice. It needs to be rather efficient since I am applying to large lists, in a large sets of lists.

I have a quick code that seems to do the job, but I don't like all those appends.

Myarrangemnt[list_] :=
Module[{x = list, len = Length[list], finalarragment = {First@list},tt},
x = Drop[x, {1}];
While[Length[finalarragment] < len,
tt = First@
Cases[x,
y_ /; Equal[Last@Last@finalarragment, y[[1]]] ||
Equal[Last@Last@finalarragment, y[[2]]]];
If[First[tt] == Last@Last@finalarragment,
finalarragment = Append[finalarragment, tt],
finalarragment = Append[finalarragment, Reverse@tt]
];
x = Drop[x, First@Position[x, tt]];
];
Return[finalarragment];
];


Here is a random test list

test = RandomSample /@ (RandomSample@
Partition[RandomInteger[{1, 1000}, 100], 2, 1, -1])


Is there a more efficient way to achieve this ? Maybe with Reap and Sow and/or SortyBy ?

• Your code for generation of the test list violates your condition on number repetition, in general. Commented Feb 13, 2014 at 13:13
• @LeonidShifrin yes, that condition is not really necessary. In my case the data is not random numbers so I know for a fact they won't repeat so if there is a efficient way that requires that, for me would be fine. Commented Feb 13, 2014 at 13:16
• Brother of this question Commented Feb 28, 2014 at 7:28
• I tried this module and found that using it a second time it falls in mistakes like to have hanged in a infinite recursion or alike... can it be a problem of me or this module has a problem? Commented Jan 13, 2018 at 10:19

In your particular case, the following does the job:

lst = {{1, 2}, {10, 140}, {43, 10}, {1, 140}, {43, 2}};
List @@@ If[# === {}, {}, First[#]] &[FindHamiltonianCycle[Graph[UndirectedEdge @@@ lst]]]

(* {{1, 2}, {2, 43}, {43, 10}, {10, 140}, {140, 1}} *)


To work for your larger test, it should be generated by a variation of your code:

test = RandomSample /@ (RandomSample@Partition[RandomSample[Range[1000], 100], 2, 1, -1]);


so that each number is indeed repeated exactly two times.

Using Mathematica 7:

Needs["Combinatorica"]
Partition[Flatten@ExtractCycles@FromUnorderedPairs@list, 2, 1]


=>

{{140, 1}, {1, 2}, {2, 43}, {43, 10}, {10, 140}}

Edit

testLalmei =
RandomSample /@ (RandomSample@
Partition[RandomInteger[{1, 1000}, 100], 2, 1, -1]);

ExtractCycles@FromUnorderedPairs@testLalmei


=>

{

{643, 115, 518, 238, 469, 250, 484, 455, 314, 445, 436, 174, 950,
981, 905, 855, 531, 948, 735, 987, 380, 282, 643},

{922, 70, 780,
971, 619, 895, 237, 227, 493, 315, 516, 366, 902, 635, 882, 290,
584, 735, 273, 229, 686, 761, 940, 922},

{389, 29, 329, 614, 897,
789, 547, 383, 697, 832, 971, 482, 991, 581, 652, 328, 479, 834,
404, 646, 543, 414, 860, 280, 982, 376, 933, 992, 928, 89, 559, 500,
861, 389},

{928, 10, 523, 291, 88, 727, 319, 405, 748, 550, 526,
940, 662, 457, 881, 399, 917, 330, 975, 928},

{360, 405, 89, 360}

}

testLeonid =
RandomSample /@ (RandomSample@
Partition[RandomSample[Range[1000], 100], 2, 1, -1]);

ExtractCycles@FromUnorderedPairs@testLeonid


{

{588, 15, 268, 797, 746, 111, 341, 490, 527, 743, 163, 402, 800, 798, 652, 299, 210, 854, 355, 793, 98, 109, 466, 203, 693, 694, 575,
539, 223, 344, 549, 347, 470, 76, 594, 380, 441, 698, 875, 293, 394,
285, 300, 129, 556, 457, 240, 79, 855, 520, 950, 584, 897, 872,
638, 16, 637, 763, 602, 595, 459, 176, 89, 752, 839, 864, 494, 579,
577, 310, 169, 935, 508, 184, 22, 871, 631, 128, 995, 114, 881, 389,
885, 412, 296, 116, 932, 255, 489, 208, 900, 521, 814, 325, 974,
159, 809, 162, 690, 992, 588}

}

Edit 2. Just for fun

GraphPlot[#, DirectedEdges -> True,
VertexLabeling -> True] & /@ (Rule @@@ Partition[#, 2, 1] & /@
ExtractCycles@FromUnorderedPairs@testLalmei)


## FindCycle

cyclesF = List @@@ # &/@ FindCycle[UndirectedEdge @@@ #, Infinity, All]&;

cyclesF @{{1, 2}, {10, 140}, {43, 10}, {1, 140}, {43, 2}}
`

{{1, 2}, {2, 43}, {43, 10}, {10, 140}, {140, 1}}