Rearranging a List
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}}