7
$\begingroup$

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?

$\endgroup$
4
$\begingroup$

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}} *)
$\endgroup$
5
  • $\begingroup$ This looks very close! If we have a list {{1,2,3}, {1,2}, {3,4}}, item 1 should never be included in a subset with item 4 as they have a grouping frequency of zero. $\endgroup$ – iRyanBell Jul 11 '20 at 0:49
  • 1
    $\begingroup$ @iRyanBell I've updated the answer. It might help to give a few other 'official' examples in the question to test against. $\endgroup$ – flinty Jul 11 '20 at 1:50
  • $\begingroup$ This is very nice! The graph partitioning function describes the problem well. $\endgroup$ – iRyanBell Jul 11 '20 at 2:01
  • 1
    $\begingroup$ It's still broken in some trivial cases like {{1, 2}, {3}} - I will fix that $\endgroup$ – flinty Jul 11 '20 at 2:02
  • 1
    $\begingroup$ This had to go through several revisions! But it finally works for disconnected graphs too. $\endgroup$ – flinty Jul 11 '20 at 3:00
2
$\begingroup$

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}}
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.