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$
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$
  • $\begingroup$ Hello, the result is {2, 3, 3}. :) $\endgroup$ – yode Nov 19 '17 at 12:00
  • $\begingroup$ @yode Thank you for the correction $\endgroup$ – Coolwater Nov 19 '17 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, privacy policy and cookie policy

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