12
$\begingroup$

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

5 Answers 5

12
$\begingroup$

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.

$\endgroup$
6
$\begingroup$

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} *)
$\endgroup$
4
$\begingroup$
Catenate[Table@@@Normal[Merge[KeyIntersection[Counts/@{a,b,c}],Min]]]

{2, 3, 3}

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

ListIntersection[a, b, c]

{2, 3, 3}

$\endgroup$
2
  • $\begingroup$ Hello, the result is {2, 3, 3}. :) $\endgroup$
    – yode
    Commented Nov 19, 2017 at 12:00
  • $\begingroup$ @yode Thank you for the correction $\endgroup$
    – Coolwater
    Commented Nov 19, 2017 at 12:12
1
$\begingroup$

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

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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