# Most common sublist occurance in a list of lists

I have a list of lists,

{{a,b,c},{d,e,f},{a,b,f},{a,b,z,}...}


Can I find sublists that occur very frequently in each list? For example, in this case, {a,b} occurs in three of the above lists, and is the most common sublist.

I can in theory check the intersection of all possible test lists with each of the above, though this is prohibitive. So is there a good way of identifying the most commonly occurring list of $$k$$ elements in a list of lists?

(Equivalently, if I have a hypergraph $$G = (V,E)$$, can I find the node subset of order $$k$$ with the largest hyperdegree?)

• If your second sublist had been {a, e, f}, would you still want to {a,b} to qualify as the most common sublist, or would you want {a} to qualify? Aug 4, 2023 at 16:23
• Also, how "big" will this problem get? Are we only ever dealing with 3-element sublists? How many of these 3-element sublists can there be? Aug 4, 2023 at 16:24
• Prespecify some size $k$, e.g. $k=3$ would mean look for the most common 3-element sublist. So in the first case you give, I'm setting $k=2$ so {a,e,f} wouldn't count.
– apg
Aug 4, 2023 at 16:37
• You mean {a} wouldn't count, right? Aug 4, 2023 at 16:40
• Yes, indeed, I mean that, will edit
– apg
Aug 4, 2023 at 16:54

Not sure how this will scale, but you could start with something like this:

Sort[Counts[Catenate[Subsets[#, {2}] & /@ list]]]


The {2} is because you indicated in the comments that this example was looking for 2-element subsets. You'd adjust that to look for other pre-specified subset sizes. And of course list is your of sets.

• +1 For lengths of 10,000 and 100,000, this matches the speed of @ydd's answer. I don't know what the OP had in mind but this seem pretty fast for even "large" lists.
– JimB
Aug 4, 2023 at 18:10

This gets big very fast but is fine for small lists. Let's use your list and $$k=2$$:

list = {{a, b, c}, {d, e, f}, {a, b, f}, {a, b, z}};
k = 2;


We can ask for only Subsets consisting of exactly k elements, and tally the unique subsets:

tab = Tally@Flatten[Subsets[#, {k}] & /@ list, 1];
tallies = tab[[All, 2]];


Then find the position (or positions if a tie) with the largest tally:

maxTalliesPos = PositionLargest@tallies
Part[tab, #, 1] & /@ maxTalliesPos
(*{{a, b}}*)

• +1 It depends on your definition of "big". Your code seems pretty fast for a list of length 10,000 (0.03 seconds) and even 100,000 (0.35 seconds).
– JimB
Aug 4, 2023 at 18:08

For an example we create some random list of list of say 3 elements:

dat = Table[Sort@RandomSample[Range[5], 3], 10]
elem = Union @@ dat

{{1, 2, 3}, {3, 4, 5}, {2, 3, 4}, {1, 4, 5}, {2, 3, 5}, {1, 4, 5}, {2,3, 5}, {1, 3, 5}, {1, 4, 5}, {2, 3, 4}}

{1, 2, 3, 4, 5}


Assume we are looking for sublists with "nelements" elements, for an example:

nelements=2


Possible sublists are:

sublists = Subsets[elem, {nelements}]

{{1, 2}, {1, 3}, {1, 4}, {1, 5}, {2, 3}, {2, 4}, {2, 5}, {3, 4}, {3,
5}, {4, 5}}


Now we count how many times each sublist occurs in our data:

counts = Count[dat, {___, #[[1]], ___, #[[2]], ___}] & /@ sublists

{1, 2, 3, 4, 5, 2, 2, 3, 4, 4}


To extract the sublist that occurs most frequently is easy:

sublists[[ PositionLargest[counts] ]]

{{2, 3}}


Using GatherBy and Repeated:

list = {{a, b, c}, {d, e, f}, {a, b, f}, {a, b, z}};

First@Flatten[GatherBy[Subsets[#, {2}] & /@ list, Repeated[#] &], 2]

(*{a, b}*)


Considering what @JimB points out, the generalization could be seen as follows:

list = {{"k", "w", "z"}, {"a", "c", "s"}, {"o", "s", "s"}, {"h", "n", "u"},
{"a", "b", "j"}, {"f", "j", "k"}, {"a", "r", "w"}, {"f", "r", "u"},
{"b", "e", "t"}, {"a", "a", "t"}};

Sort[KeyMap[#[[1]] &, GroupBy[Flatten[Subsets[#, {2}] & /@ list, 1],
Repeated, Length]]]

(*<|{"k", "w"} -> 1, {"k", "z"} -> 1, {"w", "z"} -> 1, {"a", "c"} -> 1,
{"a", "s"} -> 1, {"c", "s"} -> 1, {"s", "s"} -> 1, {"h", "n"} -> 1,
{"h", "u"} -> 1, {"n", "u"} -> 1, {"a", "b"} -> 1, {"a", "j"} -> 1,
{"b", "j"} -> 1, {"f", "j"} -> 1, {"f", "k"} -> 1, {"j", "k"} -> 1,
{"a", "r"} -> 1, {"a", "w"} -> 1, {"r", "w"} -> 1, {"f", "r"} -> 1,
{"f", "u"} -> 1, {"r", "u"} -> 1, {"b", "e"} -> 1, {"b", "t"} -> 1,
{"e", "t"} -> 1, {"a", "a"} -> 1, {"o", "s"} -> 2, {"a", "t"} -> 2|>*)

• This doesn't allow for ties but the bigger problem is that it rarely gives the pair with the largest frequency. It does give the right answer for this particular list but not for list={{"k", "w", "z"}, {"a", "c", "s"}, {"o", "s", "s"}, {"h", "n", "u"}, {"a", "b", "j"}, {"f", "j", "k"}, {"a", "r", "w"}, {"f", "r", "u"}, {"b", "e", "t"}, {"a", "a", "t"}}.
– JimB
Aug 4, 2023 at 18:27
• Thanks, @JimB! :-) Aug 4, 2023 at 19:46
list = {{a, b, c}, {d, e, f}, {a, b, f}, {a, b, z}};


Using Tally and Splice (new in 12.1)

Catenate @ MaximalBy[Last] @ Tally @ Map[Splice @ Subsets[#, {2}] &, list]


{{a, b}, 3}

For the 2 element case but could be generalized.

list = {{a, b, c), {d, e, f}, {a, b, f},
{a, b, z}};
su = Catenate[Subsets[#,{2}]&/@list];
arg = Join[list, su];
g = RelationGraph[SubsetQ,arg];
el = Graph[DeleteCases[EdgeList[g],
DirectedEdge[a_, a_]]];
vid = VertexInDegree [el];
Pick[VertexList[el], vid,Max[vid]]


yields {{a,b}}

{{a, b, c}, {d, e, f}, {a, b, f}, {a, b, z}} //
Map[Subsets[#, {2}]&] //
Catenate //
Commonest


{{a, b}}