11
$\begingroup$

I have two lists, list A and list B. All of the elements of A are members of B. The order of B is fixed but the order of A is random. I need to arrange the elements in A as given in B.

Example let A

A={5,2,8}

and B is

B={9,2,6,8,5,1}

I need to reorder A to be:

A={2,8,5}

I'm looking for a clever one-liner. This is similar to How to order a list to match the order of another list? but there the two lists have the same length. I tried some variations on adding some padding.

From the clever solutions below I have settled on using:

OrderLike[A_List,B_List]:=Cases[Alternatives @@ A]@B;

Which has been shown to be the fasted and most poetic. (However, Its poeticness is a subjective matter unlike its speed.)

$\endgroup$
0

2 Answers 2

13
$\begingroup$
SortBy[Position[B, #]&]@A

{2, 8, 5}

and

SortBy[PositionIndex @ B] @ A (* thanks: WReach *)

{2, 8, 5}

Also,

Cases[Alternatives @@ A] @ B
Select[MatchQ[Alternatives @@ A]] @ B
DeleteCases[Except[Alternatives @@ A]] @ B

Update: Some timing comparisons:

f1[a_, b_] := SortBy[FirstPosition[b, #] &]@a;
f2[a_, b_] := SortBy[Position[b, #] &]@a;
f3[a_, b_] := SortBy[PositionIndex @ b]@a;
f4[a_, b_] := Cases[Alternatives @@ a] @ b;
f5[a_, b_] := Select[MatchQ[Alternatives @@ a]] @ b;
f6[a_, b_] := DeleteCases[Except[Alternatives @@ a]] @b;
funcs = {"f1", "f2", "f3", "f4", "f5", "f6"};

SeedRandom[1]
nb = 10000;
na = 5;
b = RandomSample[Range[10^6], nb];
a = RandomSample[b, na];
t1 = First@RepeatedTiming[r1 = f1[a, b];];
t2 = First@RepeatedTiming[r2 = f2[a, b];];
t3 = First@RepeatedTiming[r3 = f3[a, b];];
t4 = First@RepeatedTiming[r4 = f4[a, b];];
t5 = First@RepeatedTiming[r5 = f5[a, b];];
t6 = First@RepeatedTiming[r6 = f6[a, b];];
r1 == r2 == r3 == r4 == r5 == r6

True

timings = {t1, t2, t3, t4, t5, t6};
Grid[Prepend[SortBy[Last]@Transpose[{funcs, timings}], {"function", "timing"}], 
 Dividers -> All]

$\begin{array}{|c|c|} \hline \text{function} & \text{timing} \\ \hline \text{f4} & 0.0009 \\ \hline \text{f6} & 0.0028 \\ \hline \text{f1} & 0.003 \\ \hline \text{f2} & 0.0034 \\ \hline \text{f5} & 0.004 \\ \hline \text{f3} & 0.012 \\ \hline \end{array}$

With na = 1000 we get

$\begin{array}{|c|c|} \hline \text{function} & \text{timing} \\ \hline \text{f4} & 0.0014 \\ \hline \text{f3} & 0.016 \\ \hline \text{f2} & 0.0737 \\ \hline \text{f6} & 0.117 \\ \hline \text{f5} & 0.118 \\ \hline \text{f1} & 0.59 \\ \hline \end{array}$

$\endgroup$
14
  • 3
    $\begingroup$ Cases[B, Alternatives@@A] is real-world poetry. $\endgroup$
    – Roman
    May 4, 2019 at 6:12
  • 4
    $\begingroup$ +1. Also: SortBy[A, PositionIndex[B]] $\endgroup$
    – WReach
    May 4, 2019 at 6:38
  • 2
    $\begingroup$ @WReach good idea to use an Association in SortBy. It's not in the documentation and looks very useful for future reference. $\endgroup$
    – Roman
    May 4, 2019 at 12:52
  • 1
    $\begingroup$ Beautiful one-liners! I did not specify in my question but in my case, B only has unique elements. I have gone with the following solution: OrderLike[A_List,B_List]:=SortBy[A,FirstPosition[B,#]&]; I took out some of the syntactic sugar for us mere mortals. $\endgroup$
    – c186282
    May 4, 2019 at 16:49
  • 1
    $\begingroup$ @c186282 it looks like you've chosen the slowest of all proposed methods. The one you picked has a runtime that scales quadratically with the lengths of the lists, whereas other methods scale linearly. $\endgroup$
    – Roman
    May 4, 2019 at 18:44
6
$\begingroup$

benchmarks

No new methods here, only benchmarks of methods given in @kglr's answer.

Clear[timings];
timings[n_Integer] := timings[n] = 
  Module[{A, B, a1, a2, a3, a4, a5, a6, t1, t2, t3, t4, t5, t6},
    B = RandomSample[Range[n]];
    A = RandomSample[B, Floor[n/2]];
    t1 = First[AbsoluteTiming[a1 = SortBy[Position[B, #] &]@A;]];
    t2 = First[AbsoluteTiming[a2 = SortBy[A, FirstPosition[B, #] &];]];
    t3 = First[AbsoluteTiming[a3 = SortBy[PositionIndex@B]@A;]];
    t4 = First[AbsoluteTiming[a4 = Cases[Alternatives @@ A]@B;]];
    t5 = First[AbsoluteTiming[a5 = Select[MatchQ[Alternatives @@ A]]@B;]];
    t6 = First[AbsoluteTiming[a6 = DeleteCases[Except[Alternatives @@ A]]@B;]];
    If[a1 == a2 == a3 == a4 == a5 == a6, {t1, t2, t3, t4, t5, t6}, $Failed]]

ListLogLogPlot[Transpose[Table[Thread[{n, timings[n]}],
  {n, Round[10^Range[3, 9/2, 1/4]]}]],
  Joined -> True, PlotLegends -> Range[6],
  Frame -> True, FrameLabel -> {"n", "time [s]"}]

enter image description here

Observations:

  • Methods 5 and 6 are almost indistinguishable in their timings.
  • Methods 3 & 4 scale linearly with $n$.
  • Methods 1, 2, 5, 6 scale quadratically with $n$.
  • Method 4 is the absolute front-runner: Cases[Alternatives @@ A]@B. Fast & poetic.
$\endgroup$
2
  • 2
    $\begingroup$ Very nice I have changed my choise of method. I cannot miss out on fast and poetic. $\endgroup$
    – c186282
    May 4, 2019 at 19:11
  • 1
    $\begingroup$ Always good to see visuals of benchmarks. $\endgroup$
    – geordie
    May 6, 2019 at 12:48

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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