# 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. – J. M. will be back soon Jun 14 '16 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 '16 at 1:35
• @J.M. reply at the same moment with same idea~ :) – Wjx Jun 14 '16 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. – J. M. will be back soon Jun 14 '16 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. – CrypticParadigm Jun 14 '16 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~

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 '16 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? – CrypticParadigm Jun 14 '16 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. – ubpdqn Jun 14 '16 at 6:50
• Oh okay. I think I see what you mean. – CrypticParadigm Jun 14 '16 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. – CrypticParadigm Jun 14 '16 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. :) – ubpdqn Jun 15 '16 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. – CrypticParadigm Jun 16 '16 at 4:19
• @physicsmajor I have edited. – yode Jun 16 '16 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.