# Pairwise similarity comparison

I have a 444-member array of arrays called final, with each subarray containing 12 integer members. How can I do a pairwise comparison of the contents of the subarrays to find all pairs with 11 members in common ; failing that, all those with 10 in common ; etc. ?

Is there a built-in similarity measure for numeric arrays?

EDIT for clarity : I would be happy if the function returned the pair with maximum similarity, or an array of such pairs in the case of a multi-way tie.

Seeking the function Foo

In[1]:= bar = RandomInteger[9, {6, 4}]
Out[1]= {{6, 6, 1, 5}, {4, 0, 9, 3}, {0, 4, 2, 9},
{4, 6, 0, 6}, {2, 5, 4, 8}, {4, 1, 9, 1}}

In[2]:= Foo[%]
Out[2]= {{4, 0, 9, 3}, {0, 4, 2, 9}}

In[3]:= Foo[bar]
Out[3]= {bar[1], bar[2]}

• does order matter? ,e.g {1,2,3}, {2,1,5} "similar" having 2 elements in common. A small test example and desired result would be helpful. Nov 15, 2014 at 5:13
• I have included an example. Thank you for the suggestion. Nov 15, 2014 at 5:28
• How many distinct integers are there in total? Nov 15, 2014 at 5:43
• Oof, I don't know. Approximately 168. They are all primes below 1000, so I'm guessing each prime is present at least once. But I'd like if it was as general as possible. Nov 15, 2014 at 5:52
• How may common items are there in {{6, 6, 1, 5}, {4, 6, 0, 6}}? One or two? The accepted answer counts one. Is that correct? Nov 15, 2014 at 19:53

Update: a single function that combines all the steps:

ClearAll[sF, sortedF];
sF = -Length[Intersection @@ #] &;
sortedF = With[{s = Subsets[#, {2}]}, SortBy[s, sF]] &;

First@sortedF@bar
(* {{4, 0, 9, 3}, {0, 4, 2, 9}} *)

sortedpairs = sortedF@bar;
Grid[{#, -sF@#} & /@ sortedpairs]


Original post

sF = -Length[Intersection @@ #] &;


Examples:

OP's example:

bar= {{6, 6, 1, 5}, {4, 0, 9, 3}, {0, 4, 2, 9}, {4, 6, 0, 6}, {2, 5, 4, 8}, {4, 1, 9, 1}};
SortBy[Subsets[bar, {2}], sF][[1]]
(* {{4, 0, 9, 3}, {0, 4, 2, 9}} *)


All pairs sorted by the cardinality of intersection:

SeedRandom[123];
arrays = RandomInteger[9, {5, 4}];
pairs = Subsets[arrays, {2}];
srtdpairs = SortBy[pairs, sF];
Grid[Thread[{{"arrays", "pairs", "sorted\npairs"}, Join @@ {{Column@arrays},
Grid[Join[{{"pair", "similarity"}}, {#, -sF@#} & /@ #]] & /@ {pairs, srtdpairs}}}],
Alignment -> Center, Dividers -> All]


Update: A MatrixPlot of the pairwise similarities for a 50 x 12 array:

SeedRandom[12];
ClearAll[sF, sortedF];
sF = -Length[Intersection @@ #] &;
arrays = RandomInteger[9, {50, 12}];
MatrixPlot[Outer[-sF[{##}]/9 &, arrays, arrays, 1], ImageSize -> 500,
ColorFunction -> "SolarColors", ColorFunctionScaling -> False]


• very nice...I posted my ugly answer to with counting repeated elements, hence, the third from the bottom of your update has {6,6} in both. Nonetheless, I continue to learn so much from you +1 :) Nov 15, 2014 at 7:48
• Thank you @ubpdqn. Multiset intersection version is definitely more challenging. I have to say I hope the OP just wants the plain old Intersection:)
– kglr
Nov 15, 2014 at 8:23
• This answer fit the bill perfectly, thank you! I'm curious why you put the word 'similarity' in quotes - is there a better term? Nov 15, 2014 at 16:30
• @pgblu, no hidden meaning in quotes :)-- i think 'similarity' is a perfectly fitting term.
– kglr
Nov 15, 2014 at 16:36
• Хорошо. I especially appreciate the middle line that just extracts the top result. With my dataset, the last command results in (as you can imagine) a list of 444 x 443 items! Nov 15, 2014 at 16:56

EDIT

There were some issues with my original post that I have modified.

In case you wish to count {6,6,3},{6,6,2} as having 2 elements in common rather than 1 (as Intersection produces), I present this rather ugly code. Note assumes integers from 0 to 9. Could be adapted.

func[data_, a_, n_] :=
Module[{var = Table[Unique["x"], {Length[a]}], r, rl, sub, f, pck,
res},
sub = Subsets[data, {2}];
f = Times @@ (# /. r) &;
pck = (Log[#] /. rl) == n & /@ PolynomialGCD @@@ Map[f, sub, {2}];
res = Normal[GroupBy[Pick[sub, pck], First -> Last]];
Join @@ Function[{x, y}, {x, #} & /@ y] @@@ res
]


where a is alphabet and n is then number of elements that agree. The output is now more like kguler but with counting repeats:

Column[# ->
Column[Row /@
func[{{6, 6, 1, 5}, {4, 0, 9, 3}, {0, 4, 2, 9}, {4, 6, 0,
6}, {2, 5, 4, 8}, {4, 1, 9, 1}}, Range[0, 9], #]] & /@
Range[0, 4], Frame -> All]


More cumbersome example: r

i = {{0, 6, 3, 8}, {8, 8, 8, 0}, {1, 1, 6, 7}, {7, 0, 2, 1}, {5, 1,
3, 5}, {5, 9, 7, 9}, {2, 9, 8, 9}, {5, 4, 5, 2}, {5, 8, 5, 8}, {6,
4, 0, 6}, {6, 3, 3, 1}, {1, 1, 1, 0}, {1, 0, 5, 2}, {2, 3, 1,
0}, {2, 2, 7, 7}, {6, 1, 2, 1}, {0, 9, 3, 6}, {2, 9, 2, 3}, {0, 8,
2, 7}, {3, 7, 8, 0}}
FlipView[Framed /@ (# ->
Row[{Column[Row /@ func[ri, Range[0, 9], #]],
Length@(func[ri, Range[0, 9], #])}] & /@ Range[0, 4])]


• (+1) this may well be what the OP wants. Btw, counted (manually) 16 system functions in your Module (not including Rule, Map, Apply...):)
– kglr
Nov 15, 2014 at 8:25
• @kguler... I said it was ugly...just had a flight of fancy converting to polynomial then using Log and replacement of variable e to count...it's been a long week so almost certainly this was poor but perversely fun Nov 15, 2014 at 8:33
• ubdqn, i really meant it as a compliment:)
– kglr
Nov 15, 2014 at 8:38
• Compliments from me too - I look forward to exploring your solution further! My green check mark went to kguler's answer only because my sets don't in fact contain any duplicates. Your solution looks like it would be even more general though, is that right? Nov 15, 2014 at 16:57