# Finding the most common n-tuples of a list of lists where order does not matter

I am still learning to use Mathematica and I need some help. How could I get the most common pair, and generally the most common n-tuple of a list (row vector) given a list of lists of m x 5 dimensions? Suppose as a sample I have a list of lists, dimension 9 x 5 of numbers

A =
53  21  2   49  3
44  31  26  35  46
3   45  44  24  19
19  25  60  12  16
31  44  20  35  46
21  53  2   49  20
5   23  49  18  27
7   22  33  42  58
21  53  2   49  5


More specifically in Mathematica code:

A = {
{53, 21, 2, 49, 3}, {44, 31, 26, 35, 46}, {3, 45, 44, 24, 19},
{19,25, 60, 12, 16}, {31, 44, 20, 35,46}, {21, 53, 2, 49, 20},
{5, 23, 49, 18, 27}, {7, 22, 33, 42, 58}, {21, 53, 2, 49, 5}}


Suppose I want to find the most common 4-tuple of the entire list of lists (A). One scenario could be {53, 21, 2, 49} is the most common 4-tuple of the list of lists. Another scenario could be that {44, 31, 35, 46} is the most common 4-tuple.

More concretely, in the given list A , the most common 4-tuple is {53, 21, 2, 49} since that 4-tuple occurs three times-- one on the first row, one the sixth row, and one on the last row. As you may have noticed, the order does not matter.

The second most common 4-tuple would be {44, 31, 35, 46} since it occurs twice--once on the second row and again on the fifth row.

And then calling on Tally to get a result like {{{53, 21, 2, 49},3}, {{44, 31, 35, 46}, 2},...}

I would like to be able to do this with 2-tuples, 3-tuples, 4-tuples, and 5-tuples. I was able to do 1-tuples trivially by using Flatten[A] on the list of lists then Tally[%]. Any guidance, tips, suggestions is appreciated.

• Try Tally[Flatten[Subsets[Sort[#], {4}] & /@ A, 1]] and report back. Jun 14, 2016 at 1:33
• will $Subsets$ and $Tally$ help? you can use $Tally[list,Sort@#==Sort@#2&]$ to ignore the order while tallying.
– Wjx
Jun 14, 2016 at 1:35
• @J.M. reply at the same moment with same idea~ :)
– Wjx
Jun 14, 2016 at 1:36
• Yes, @Wjx; if the OP thinks it is what he needs, you have my express permission to post that solution on my behalf. ;) Note the second argument of Subsets[], BTW. Jun 14, 2016 at 1:39
• I think that did the trick! I tested the sample and it gave me the expected result. Thank you friends, I appreciate it greatly. Jun 14, 2016 at 1:39

ClearAll[f]
f = With[{a = #, s = #2, n = #3}, Commonest[Flatten[Subsets[Sort@#, {s}] & /@ a, 1], n]] &;

f[A, 4, 1]


{{2, 21, 49, 53}}

f[A, 4, 2]


{{2, 21, 49, 53}, {31, 35, 44, 46}}

f[A, 3, 2]


{{2, 21, 49}, {2, 21, 53}}

f[A, 5, 2]


{{2, 3, 21, 49, 53}, {26, 31, 35, 44, 46}}

I still will post this answer though, fortunately, OP has already got a solution~

The following code will work:

Tally[Flatten[Subsets[Sort[#], {4}] & /@ A, 1]]

Tally[Flatten[#~Subsets~{4}&/@A,1],Sort@#==Sort@#2&]


Truely an interesting thing for @J.M. and I came up woth the same solution ay the same time. :) cheers~

Customized function for your demand.

SeletSubTuple[l_,n_]:=Keys[TakeLargest[Counts[Sort/@Catenate[Subsets[#,{4}]&/@l]],n]]


# Usage

SeletSubTuple[A, 1]


{{2, 21, 49, 53}}

SeletSubTuple[A, 2]


{{2, 21, 49, 53}, {31, 35, 44, 46}}

If this can serve,It's my honor. :)

• facinating usage of functions!
– Wjx
Jun 14, 2016 at 6:53

This is just play. In the following the list A in OP is a:

Finding the pairwise non-empty intersections and counting:

tal = (Tally[
Flatten[Outer[Intersection, a, a, 1] /. {} -> Sequence[],
1]] /. {__, 1} :> Sequence[])[[All, 1]];


Determining desired result:

u = tal~Join~a;
rg = RelationGraph[SubsetQ[#1, #2] && MemberQ[a, #1] && #1 != #2 &, u,
VertexShapeFunction -> (Text[
Framed[Style[#2, Bold], Background -> White], #] &)]
Grid[SortBy[{Length@#, #, VertexDegree[rg, #]} & /@ tal, {First,
Last}]] Ugly but for completion:

fun[lst_, p_] :=
Module[{ta = (Tally[
Flatten[Outer[Intersection, lst, lst, 1] /. {} -> Sequence[],
1]] /. {__, 1} :> Sequence[])[[All, 1]], sb},
sb = SortBy[{#, Total@Map[Function[x, Boole@SubsetQ[x, #]], a]} & /@
ta, {Length[#[]], #[]} &];
If[p == "All", Grid[sb],
GroupBy[sb, Length@#[] & -> (## &), Last][p]]
]


Testing:

fun[a,4]
fun[a,"All"] • So with this code I can basically count all of the most common n-tuples for each n = 1,...,5? Jun 14, 2016 at 6:30
• @physicsmajor it counts shared proper subsets (pair wise intersections and remove diagonal elements), as graph shows. As every set is subset of itself these loops were eliminated. However, if 2 lists were replicated they could either dealt with upfront or would appear in list tal. Jun 14, 2016 at 6:50
• Oh okay. I think I see what you mean. Jun 14, 2016 at 7:02
• I'm trying to run your code, but something is going wrong when running the second block: rg doesn't give an output and so everything in that block after that doesn't give a valid output. I tried to see what was wrong, but couldn't figure it out. Jun 14, 2016 at 15:42
• @physicsmajor I am sorry for the delay in replying. I have been asleep. I have added he code for the testing. I only placed the function definition. I believe you were just running the function definition. In the above A has been replaced by a. I hope this is the issue. If not let me know. :) Jun 15, 2016 at 2:03

Post another solution by graph

g = SimpleGraph[
Graph[If[SubsetQ[#1, #2], DirectedEdge[#1, #2], Nothing] & @@@
Tuples[{A, Sort /@ Catenate[Subsets[#, {4}] & /@ A]}]]] n = 1; VertexList[g, _?(Or @@
TakeLargest[DeleteDuplicates[VertexInDegree[g]], n]] &)]


{{2, 21, 49, 53}}

You can adjust the n to select the 4-tuples arisen frequency of ranking

• If A is the list of lists I provided, what is a in your code? It doesn't seem to run properly. I may be doing something incorrectly. Jun 16, 2016 at 4:19
• @physicsmajor I have edited.
– yode
Jun 16, 2016 at 4:22

( This is an extended comment, although the code can be used to produce an answer with dataset in the question. )

Question's request is very closely related to the fundamental task of finding frequent sets in Association Rule Learning (ARL). (ARL is an approach in unsupervised machine learning.)

As far as I can tell, Mathematica does not have a dedicated built-in function for ARL, but there are enough, well performing functions for doing ARL.

The rest of this answer shows the use of the package AprioriAlgorithm.m, which I have used in the last five-six years; it is based on the so called Apriori algorithm. More effective algorithms (and packages) for ARL exist. For example R's "arules" uses the very fast "eclat" written in C.

Here we generate some data using dictionary words:

ClearAll[A]
A = Characters /@ DictionaryLookup["*"];


Here we find the frequent sets with probability of appearance greater or equal to 5%:

minProb = 0.05;
AbsoluteTiming[
{ares, itemToIndexRules, indexToItemRules} = AprioriApplication[A, minProb];
]

(* {2.53581, Null} *)


Here are the lengths of the sets of frequent sets found:

Length /@ ares
(* {22, 131, 243, 118, 8} *)


Here are the frequent sets with 5 elements.

ares[] /. indexToItemRules

(* {{"a", "e", "i", "n", "r"}, {"a", "e", "i", "n", "t"},
{"a", "e", "i", "r", "t"}, {"a", "e", "r", "s", "t"},
{"e", "i", "n", "r", "s"}, {"e", "i", "n", "r", "t"},
{"e", "i", "n", "s", "t"}, {"e", "i", "r", "s", "t"}} *)


Note that using the package AprioriAlgorithm.m can provide results faster that say using Commonest / Subsets because Apriori uses an argument specifying the lower threshold for the frequencies of the sets, and hence candidate sets can be very effectively eliminated.