How to use Intersection[] but keep the original list order?

Question

I want to keep the original order of l1:

l1 = {"qwe", "abc", "abb", "aba", "ddd"};
l2 = {"abc", "abd", "aba", "qwe"};
Intersection[l1, l2]

Output: {"aba", "abc", "qwe"}

Expected output: {"qwe", "abc", "aba"}

Answer 1

To keep the original order, use Cases[] with Alternatives:

l1 = {"qwe", "abc", "abb", "aba", "ddd"};
l2 = {"abc", "abd", "aba", "qwe"};
Cases[l1, Apply[Alternatives, l2]]

Output: {"qwe", "abc", "aba"}

Use AbsoluteTiming to benchmark this solution - processing time is comparable to Intersection[].

If this helps you, remember to up-vote. :)

AbsoluteTiming[] benchmarks: (see dataset creation instructions below)

Intersection[l1, l2]; // AbsoluteTiming

{0.008827, Null}

Cases[l1, Apply[Alternatives, l2]]; // AbsoluteTiming

{0.003104, Null}

Select[l1, MemberQ[l2, #] &]; // AbsoluteTiming

{2.24958, Null}

Map[If[MemberQ[l2, #], #, Nothing] &, l1]; // AbsoluteTiming

{2.22717, Null}

Reap[If[MemberQ[l2, #], Sow[#]] & /@ l1][[2, 1]]; // AbsoluteTiming

{2.21488, Null}

PositionIndex[Join[l1, l2]] // Select[Length[#] > 1 &] // 
    Values[#, First] & // Part[Join[l1, l2], #] &; // AbsoluteTiming

{0.033102, Null}

With[{L = Join[l1, l2]}, 
   Part[L, Values[Select[PositionIndex@L, Length@# > 1 &]][[All, 
      1]]]]; // AbsoluteTiming

{0.032718, Null}

CreateDataStructure["OrderedHashSet", l1]["Intersection", l2][
   "Elements"]; // AbsoluteTiming

in Mathematica 12.1

{0.011508, Null}

list = Map[StringJoin, Tuples[RandomSample[Alphabet[], 5], 6]];
Print["List length: ", Length[list]]
l1 = RandomSample[list, IntegerPart[Length[list]*0.6]];
l2 = RandomSample[list, IntegerPart[Length[list]*0.6]];

List length: 15625

Answer 2

One way to keep the order in l1 is this:

l1 = {"qwe", "abc", "abb", "aba", "ddd"};
l2 = {"abc", "abd", "aba", "qwe"};
Select[l1, MemberQ[l2, #] &]
(* {"qwe", "abc", "aba"} *)

Note that the Select function has been in Mathematica since version 1.0. The alternative Map[If[MemberQ[l2, #], #, Nothing] &, l1] does the same thing. A variant is Reap[If[MemberQ[l2, #], Sow[#]] & /@ l1][[2, 1]].

Answer 3

You can use the new data structure functionality in M12.1 to do this. For example:

l1 = {"qwe", "abc", "abb", "aba", "ddd"};
l2 = {"abc", "abd", "aba", "qwe"};

ds = CreateDataStructure["OrderedHashSet", l1]["Intersection", l2]["Elements"]

{"qwe", "abc", "aba"}

A bit of explanation. CreateDataStructure["OrderedHashSet", l1] creates a data structure containing l1. Then, giving "Intersection", l2 as the arguments of the data structure intersects the contents of the data structure with the set l2, returning the data structure. Finally, using "Elements" as the argument to the returned data structure gives the remaining elements.

Answer 4

A wonderfully over-engineered solution:

l1 = {"qwe", "abc", "abb", "aba", "ddd"};
l2 = {"abc", "abd", "aba", "qwe"};
PositionIndex[Join[l1, l2]] //
   Select[Length[#] > 1 &] //
   Values[#, First] & //
   Part[Join[l1, l2], #] &

Answer 5

Using DeleteCases, Complement and Alternatives:

DeleteCases[l1, Alternatives @@ Complement[l1, l2]]

(*{"qwe", "abc", "aba"}*)

Answer 6

Since V 13.1 there is DeleteElements

l1 = {"qwe", "abc", "abb", "aba", "ddd"};
l2 = {"abc", "abd", "aba", "qwe"};

DeleteElements[l1, Complement[l1, l2]]

{"qwe", "abc", "aba"}

Answer 7

Clear["Global`*"];
l1 = {"qwe", "abc", "abb", "aba", "ddd"};
l2 = {"abc", "abd", "aba", "qwe"};

r1 = # -> # & /@ l1
r2 = # -> # & /@ l2

KeyTake[r2, Keys@r1] // Keys

{"qwe", "abc", "aba"}