How to sort a list by another list?

Question

I have a list and a order

list = {{{357, 120}, {271, 78}}, {{239, 90}, {259, 77}}, {{259, 
     71}, {165, 25}}, {{271, 70}, {337, 30}}};
order = {{259, 77}, {259, 71}, {271, 78}, {271, 70}};

So any beautiful method to sort the list by order?The current method is look sounds clumsy:

Catenate@MapThread[
  Complement, {Catenate[Select[list, MemberQ[#]] & /@ order], 
   List /@ order}]

{{239, 90}, {165, 25}, {357, 120}, {337, 30}}

Answer 1

If I'm understanding your question correctly, something like this would work:

list = {{{357, 120}, {271, 78}}, {{239, 90}, {259, 77}}, {{259, 
     71}, {165, 25}}, {{271, 70}, {337, 30}}};
order = {{259, 77}, {259, 71}, {271, 78}, {271, 70}};

SelectFirst[
  SelectFirst[list, MemberQ[#]],
  UnequalTo[#]
] & /@ order

(* {{239, 90}, {165, 25}, {357, 120}, {337, 30}} *)

The inner SelectFirst picks out the pair from list which contains the current element in order. The outer SelectFirst then chooses the element which is not equal to the one in order.

As Jason B points out, UnequalTo is a new addition in 10.4. In 10.3 you could use Not @* EqualTo[#] instead, but before that you'll have to use a closure or something like that:

With[{elem = #},
  SelectFirst[
    SelectFirst[list, MemberQ[#]],
    # != elem &
  ]
] & /@ order

Alternatively, a simple pattern-based approach:

FirstCase[list, {a_, #} | {#, a_} :> a] & /@ order

(* {{239, 90}, {165, 25}, {357, 120}, {337, 30}} *)

This second approach is actually a bit faster, in case you want to handle large lists:

list = RandomInteger[400, {2000, 2, 2}];
order = RandomSample[RandomChoice /@ list];
RepeatedTiming[
  SelectFirst[
    SelectFirst[list, MemberQ[#]],
    UnequalTo[#]
  ] & /@ order;
]
(* {4.04, Null} *)

RepeatedTiming[
  FirstCase[list, {a_, #} | {#, a_} :> a] & /@ order;
]
(* {2.682, Null} *)

Answer 2

Here are two variants on the same idea of using Nearest. The first is a little faster on small lists and on large lists. They're about the same on @Martin Ender's example in his answer.

Flatten[Nearest[Join[#1, #2] -> Join[#2, #1] & @@ Transpose@list,
  order, {1, 0}], 1]
Flatten[Nearest[Flatten[list, 1] -> Flatten[Reverse /@ list, 1],
  order, {1, 0}], 1]
(*
  {{239, 90}, {165, 25}, {357, 120}, {337, 30}}
  {{239, 90}, {165, 25}, {357, 120}, {337, 30}}
*)

Timings on @Martin Ender's example. Note that the uniqueness of the result depends on the uniqueness of the sorting keys in order. For RandomInteger[400, {2000, 2, 2}] with SeedRandom[0], the keys were not unique, so I increased the size of the integers to make them so.

SeedRandom[0];
list = RandomInteger[4000, {2000, 2, 2}];
order = RandomSample[RandomChoice /@ list];

foo1 = Flatten[
    Nearest[Join[#1, #2] -> Join[#2, #1] & @@ Transpose@list, 
     order, {1, 0}], 1]; // RepeatedTiming

foo2 = Flatten[Nearest[Flatten[list, 1] -> Flatten[Reverse /@ list, 1],
     order, {1, 0}], 1]; // RepeatedTiming

foo3 = FirstCase[list, {a_, #} | {#, a_} :> a] & /@  (* Martin Ender's faster one *)
    order; // RepeatedTiming

foo1 == foo2 == foo3

(*
  {0.0024, Null}
  {0.0024, Null}
  {1.955, Null}
  True
*)

---

Addendum. Note that part of the slowness of FirstCase is that it unpacks list (repeatedly). A single unpacking of list does not take that much time compared to the overall time. It makes a difference whether the call to FirstCase[] is by reference to the stored array, listup below, or is directly on the output of FromPackedArray. It seems in the latter case, the array is repacked and we're back to situation above, FirstCase[list,...]. Even weirder is the case where the array is unpacked to level 1. There were many warnings from On@"Packing" of unpacking to level 1, so I thought I'd see if an unpacked list of packed arrays might be faster. Instead it was much slower. Further, it depends on how it's unpacked, whether it's unpack and repacked at level 1 or simply unpacked with {##} & @@ list. The unpacking and repacking takes very little time. I'm not sure why the speed is so slow, but I thought it was worth pointing out. There is a similar difference whether FirstCase[] is called on an array stored in a symbol or the direct output of a function.

(* Completely unpacked *)
(listup = Developer`FromPackedArray@list;
   FirstCase[listup, {a_, #} | {#, a_} :> a] & /@ order); // RepeatedTiming
FirstCase[Developer`FromPackedArray[list], {a_, #} | {#, a_} :> a] & /@
    order; // RepeatedTiming
(*
  {0.604, Null}
  {1.9, Null}
*)

(* Unpacked to level 1 *)
(murf = {##} & @@ list;   (* store in murf *)
   FirstCase[murf, {a_, #} | {#, a_} :> a] & /@ order); // RepeatedTiming
FirstCase[                (* not stored in variable *)
     {##} & @@ list,
     {a_, #} | {#, a_} :> a] & /@ order; // RepeatedTiming
FirstCase[                (* unpacked & repacked below level 1 *)
     With[{opts = SystemOptions["CompileOptions"]},
      Internal`WithLocalSettings[
       SetSystemOptions["CompileOptions" -> "MapCompileLength" -> Infinity],
       Developer`ToPackedArray /@ Developer`FromPackedArray[list],
       SetSystemOptions[opts]
       ]],
     {a_, #} | {#, a_} :> a] & /@ order; // RepeatedTiming
(*
  {1.37, Null}
  {2.0, Null}
  {5.7, Null}
*)

Answer 3

Thanks for that, Michael E2. Super impressive performance with Nearest[ ]!

Sharing this for information, as an experiment with SortBy[ ]. Starting with the big data set

SeedRandom[0];
list = RandomInteger[4000, {2000, 2, 2}];
order = RandomSample[RandomChoice /@ list]; 

Tried the problem using SortBy[ ] and here is the kernel of it (skipping the bookwork on picking off the non-matching elements)

SortBy[list, (Position[order, #[[1]] |  #[[2]]]) &]; // RepeatedTiming

1.9

Most of that was computing the Position, it appears

Map[(Position[order, #[[1]] |  #[[2]]]) &, list]; // RepeatedTiming

1.887

Here's my full version and Martin Enders' The Nearest version is too cheap to meter.

foo3 = FirstCase[list, {a_, #} | {#, a_} :> a] & /@(*Martin Ender's faster one*)
order; // RepeatedTiming

foo4 = MapThread[(Complement[#1, {#2}] // First) &, 
                     {SortBy[list, (Position[order,#[[1]] | #[[2]]]) &],order}
                ]; // RepeatedTiming

2.12

1.87