Finding the best-fitting subsets by frequencies of list item groupings

Question

Suppose I have a list of groups:

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

In this example, 1 most commonly appears within a group that contains 2, and 3 most commonly appears in a group which contains 4. If we form N subgroups, where N==2, the best-fitting subgroups by frequency of grouping would be {{1,2}, {3,4}}.

As a second example, a list of groups could be defined as:

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

In this example:

• 1 is in a group with 2: 2/2 times

• 1 is in a group with 3: 1/2 times

• 1 is in a group with 4: 0/2 times

• 2 is in a group with 1: 2/3 times

• 2 is in a group with 3: 2/3 times

• 2 is in a group with 4: 0/3 times

• 3 is in a group with 1: 1/3 times

• 3 is in a group with 2: 2/3 times

• 3 is in a group with 4: 1/3 times

• 4 is in a group with 1: 0/1 time

• 4 is in a group with 2: 0/1 time

• 4 is in a group with 3: 1/1 time

Such that a valid subset grouping would include {{1,2,3},{4}} but not {1,2,3,4} (since 1 is never grouped with 4). I'm not quite sure how one would score the alternative groupings to rank {{1,2,3},{4}} against another possible grouping like {{1,2}, {3,4}} to determine the best-fitting options.

I'm open to the idea of allowing multiple subgroups to include the same item, but the number of groups returned should be manageable for large collections of unique items, such as not to explode into a full set of combinations.

With a large collection of lists, how might I divide the unique items across all sets into the best fitting subgroups, defined by the most common frequencies of the groupings?

Answer 1

I think you can pose this as a graph partitioning problem, and in the case where you want ideal groupings, FindGraphPartition "finds a partition such that the sum of edge weights for edges having endpoints in different parts is minimized" according to the documentation. Here our edge weights are the number of co-occurences:

list = {{1,2,3}, {1,2}, {2,3}, {3,4}};
allitems = Flatten[list] // DeleteDuplicates;

countoccur[groups_, {i_, j_}] := 
 Count[ContainsAll[#, {i, j}] & /@ groups, True]

edges = DeleteCases[
   If[Unequal @@ #, {UndirectedEdge @@ #, countoccur[list, #]}, 
      Nothing] & /@ Subsets[allitems, {2}], {_, 0}];

g = Graph[edges[[All, 1]], EdgeWeight -> edges[[All, 2]], 
   VertexLabels -> Automatic, EdgeLabels -> "EdgeWeight"];

(* add any missing vertices culled earlier (items in isolated groups)*)
g = VertexAdd[g, Complement[allitems, VertexList[g]]];

(* use the second argument of FindGraphPartition here if you want n 
  groups for each graph component *)
partitions = If[Length[#] > 1, FindGraphPartition[Subgraph[g, #]], {#}] & /@ 
   ConnectedComponents[g];

result = Join @@ partitions
(* result: {{3, 4}, {1, 2}} *)

Answer 2

An alternative approach: construct a WeightedAdjacencyGraph from input list and apply FindGraphPartition:

ClearAll[waG]
waG = Module[{vl = Union @@ #}, 
    WeightedAdjacencyGraph[vl, Normal[Total[(# + Transpose[#] &@
      SparseArray[Subsets[#, {2}] -> 1, {1, 1} Length@vl]) & /@ #]] /. 0 -> ∞]] &;

FindGraphPartition @ waG @ {{1, 2, 3}, {1, 2}, {2, 3}, {3, 4}}

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

FindGraphPartition @ waG @ {{1, 2}, {3}}

 {{1, 2}, {3}}

FindGraphPartition @ waG @ {{1, 2, 3}, {1, 2}, {3, 4}}

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