Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

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 ?

share|improve this question
    
Your code for generation of the test list violates your condition on number repetition, in general. –  Leonid Shifrin Feb 13 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. –  lalmei Feb 13 at 13:16
    
Brother of this question –  Rorschach Feb 28 at 7:28
add comment

2 Answers

up vote 6 down vote accepted

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.

share|improve this answer
add comment

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)

enter image description here

share|improve this answer
add comment

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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