Selecting elements from a list where the order is set by another list

Question

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.)

Answer 1

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}$

Answer 2

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]"}]

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.