Lists' intersection keeping elements' order

Question

I could use the function Intersection, but it returns a sorted list. That's why I have to do my own, but it looks too big. I hope it could be done shorter.

lists = {{1, 2, 3, 4, 5}, {1, 2, 3, 4}, {2, 3, 4, 5}};
Fold[ Function[ {a, b},
  Select[b, MemberQ[a, #] &]
  ], lists // First, lists // Rest]

Answer 1

This function deletes from the first list all the elements not contained in the intersection, thus returning what you want:

f[l_List]:= DeleteCases[First@l, Except[Alternatives @@ (Intersection @@ l)]]  

f[{{1, 2, 3, 4, 5}, {1, 2, 3, 4}, {2, 3, 4, 5}}]  
->{2,3,4}

f[{{5, 7, 6, 3}, {5, 6, 1, 3}}]
->{5,6,3}

Answer 2

Why use a reverse approach? Just do it directly!

Cases[First[list], Alternatives @@ Intersection @@ list]

If speed mattered, one could define a temporary "tester" function inside a Module to use in place of MemberQ

Module[ {f},
  (f[#] = True)& /@ (Intersection @@ list);
  Select[First[list], f]
]

This is still fairly short.

Answer 3

Most efficient and simple way for this is to sort each list before applying such algorithm. In this case you do not need to check if each number is memeber of other list but you just pick first number and compare whit other elements from beginning.

This is reason that Mathematica return sorted list. In case that each list is sorted complexity is O(N) where N is total number of all elements.