How to rearrange these two sublists
Here is a shorter, though not necessarily prettier, solution:
ReplaceList[list, {{___, l_, ___}, {___, r_, ___}} :> {l, r} -> N@EuclideanDistance[l, r]] //
SortBy[Last] //
DeleteDuplicates[#, #[[1, 1]] == #2[[1, 1]] || #[[1, 2]] == #2[[1, 2]]&] & //
{#[[All, 1, 1]] // Reverse, #[[All, 1, 2]]} &
(* {{{0, 0}, {1, 4}, {0, 7}, {8, 6}}, {{11, 11}, {11, 20}, {25, 17}, {27, 16}}} *)
Elegant is completely subjective. It could mean short or possibly easy to follow or something entirely different.
The solution below is not the shortest but I do find it relatively easy to follow.
SeedRandom[1]
list = {RandomInteger[10, {4, 2}], RandomInteger[{10, 30}, {4, 2}]}
(* { {{1, 4}, {0, 7}, {0, 0}, {8, 6}},
{{11, 20}, {11, 11}, {25, 17}, {27,16}} } *)
Step 1 - newList
A function is defined that will take as input the form of your list:
{set1, set2}
⇓
{{{w1, x1}, {w2, x2}, ..., {wn, xn}}, {{y1, z1}, {y2, z2}, ..., {yn, zn}}}
It will find the pair {{wi,xi}, {yj,zj}}
that represents the minimum distance, Sow
it and return the complete list with {wi,zi}
removed from set1
and {yj,zj}
removed from set2
.
newList[list_] := Module[
{
tuplesList = Tuples[list],
distanceList,
minimum,
position,
pair
},
distanceList = N@EuclideanDistance[#[[1]], #[[2]]] & /@ tuplesList;
minimum = N@Min[distanceList];
position = Position[distanceList, minimum];
pair = Flatten[Extract[tuplesList, position], 1];
Sow[pair];
{DeleteCases[list[[1]], pair[[1]]],
DeleteCases[list[[2]], pair[[2]]]}
]
Test it on the complete list
newList[list]
(* {{{1, 4}, {0, 7}, {0, 0}}, {{11, 20}, {25, 17}, {27, 16}}} *)
Step 2 - sortedNestedList
Using newList
we produce a sorted list using Nest
, Sow
and Reap
.
sortedNestedList = Reap[Nest[newList, list, Length@list[[1]]]][[2, 1]]
(* { {{8, 6}, {11, 11}}, {{0, 7}, {11, 20}},
{{1, 4}, {25, 17}}, {{0, 0}, {27, 16}}} *)
Step 3 - Extract the final answer
The final list is extracted from sortedNestedList
by reversing the first column (new set1
) and simply copying the second column (new set2
).
{Reverse@sortedNestedList[[All, 1]], sortedNestedList[[All, 2]]}
(* { {{0, 0}, {1, 4}, {0, 7}, {8, 6}},
{{11, 11}, {11, 20}, {25, 17}, {27, 16}}} *)
Putting it all together
The function sortedList
encapsulates the previous three steps
sortedList[list_] := Module[
{
sortedNestedList =
Reap[Nest[newList, list, Length@list[[1]]]][[2, 1]]
},
{Reverse@sortedNestedList[[All, 1]], sortedNestedList[[All, 2]]}
]
Testing it on the original list
sortedList[list]
(* { {{0, 0}, {1, 4}, {0, 7}, {8, 6}},
{{11, 11}, {11, 20}, {25, 17}, {27, 16}}} *)
Borrowing WReach's idea of using DeleteDuplicates
:
Module[{L = Tuples[list]},
L = L[[Ordering[EuclideanDistance @@@ L, All, Less]]];
L = DeleteDuplicates[L, Or @@ MapThread[Equal, {##}] &];
{Reverse[L[[All, 1]]], L[[All, 2]]}]
Edit by yode:
Transpose[DeleteDuplicates[SortBy[Tuples[list], N[EuclideanDistance @@ #] &],
ContainsAny]] // {Reverse[#], #2} & @@ # &
Edit by coolwater
Note that both of the above code fragments are wrong because of repetitions when choosing an unlucky seed:
SeedRandom[63112]
list = {RandomInteger[10, {4, 2}], RandomInteger[{10, 30}, {4, 2}]}
The following adds the distinguishability needed within DeleteDuplicates
:
Module[{L = Tuples[Range[Length[Last[list]]], 2]},
L = L[[Ordering[EuclideanDistance @@@ Tuples[list], All, Less]]];
L = DeleteDuplicates[L, MemberQ[# - #2, 0] &];
{list[[1, Reverse[L[[All, 1]]]]], list[[2, L[[All, 2]]]]}]