Select the same elements from lists

Question

I need a special intersectant operation for List other than Set.

There maybe some duplicate elements, also need to count instead of merging as Intersection.

For example:

$a=\{1,{\color\red{2}},2,{\color\red{3}},{\color\red{3}},3,4,4,4\}$

$b=\{{\color\red{2}},{\color\red{3}},{\color\red{3}},5\}$

$c=\{{\color\red{2}},2,{\color\red{3}},{\color\red{3}},4,4\}$

One 2 and two 3 appear in all list.

So $a\sqcap b\sqcap c=\{2,3,3\}$.

---

My rough attemption:

ListIntersection[list__]:=Module[{tlist=Tally/@{list},elements},
  elements=First/@Intersection[Sequence@@tlist,SameTest->(First[#1]==First[#2]&)];
  take[a_,b_]:=a[[Sequence@@(FirstPosition[a,b]+{0,1})]];
  min[b_]:=Min[take[#,b]&/@tlist];
  Flatten[ConstantArray@@@Transpose[{elements,min/@elements}]]
]

Test set:

a={1,2,2,3,3,3,4,4,4};
b={2,3,3,5};
c={2,2,3,3,4,4};
ListIntersection[a,b,c]

Answer:

{2, 3, 3}

Answer 1

I believe my approach is fairly similar to yours, but uses Association's and some built in operations on them to make the code somewhat simpler. (The fact that several of these functions have operator forms makes the code especially clean.)

ClearAll[multiIntersection]
multiIntersection[lists__List] := (
  Counts /@ {lists}
       // KeyIntersection
      // Merge[Min]
     // KeySort
    // KeyValueMap[ConstantArray]
   // Catenate
  )

You can remove the KeySort if you don't want the returned elements to be sorted.

multiIntersection[a, b, c]

{2, 3, 3}

---

Edit: Eliminated the needlessly cumbersome ConstantArray[#1, #2] & in favor of ConstantArray.

Answer 2

We can use Intersection directly if we label each list value with a number indicating how many times that value has occurred in the list so far:

label[list_] := Module[{n}, n[_] = 0; #[++n[#]]& /@ list]

label[a]
(* {1[1], 2[1], 2[2], 3[1], 3[2], 3[3], 4[1], 4[2], 4[3]} *)

So then:

(Intersection@@(label /@ {a, b, c}))[[All, 0]]
(* {2, 3, 3} *)

Answer 3

Catenate[Table@@@Normal[Merge[KeyIntersection[Counts/@{a,b,c}],Min]]]

{2, 3, 3}

Answer 4

ListIntersection[list__] := Join @@ MapThread[ConstantArray,
   {#, MapThread[Min, Outer[Count, {list}, #, 1]]} &[Intersection[list]]]

ListIntersection[a, b, c]

{2, 3, 3}

Answer 5

A simple looping method.

a = {1, 2, 2, 3, 3, 3, 4, 4, 4};
b = {2, 3, 3, 5};
c = {2, 2, 3, 3, 4, 4};

SetAttributes[f, HoldFirst]

f[l_, d_, il_] := If[il, If[++l > Length[d], Throw[x]]]

i = j = k = 1;
x = {};

Catch[While[True,
  If[a[[i]] == b[[j]] == c[[k]],
   AppendTo[x, a[[i]]];
   ii = ij = ik = True,
   ii = a[[i]] < b[[j]] || a[[i]] < c[[k]];
   ij = b[[j]] < a[[i]] || b[[j]] < c[[k]];
   ik = c[[k]] < a[[i]] || c[[k]] < b[[j]]];
  f[i, a, ii];
  f[j, b, ij];
  f[k, c, ik];
  ]]

{2, 3, 3}