SameTest issue?

Question

Folks,

I am trying to construct and algorithm which finds all of the remaining groupings (of three items, in this case) from a list of items for which no two items are in groups that have previously been formed. Here is what I wrote, which seemed pretty straightforward to me:

makeGroups[myList_, existingGroups_] := 
   Complement[Subsets[myList, {3}], existingGroups,
   SameTest -> (Length[Intersection[#1, #2]] >= 2 &)]

My thinking is that the defined "SameTest" should be comparing each item in the Subsets constructed from myList to the entries in existingGroups and rejecting items which have 2 or more overlaps with any entry in existingGroups.

However, when I run this on the following lists:

myList = Range[15];

existingGroups = Partition[Range[15],3];

I get results which do not include some obviously unique groups (there is no group which has 1 and 15 in it, for example).

Any ideas where I have gone off the rails?

Alternatively, if you have a better way of solving this same problem I would love to hear/see it.

Answer 1

Can you check if this works for you?

With[{p = Subsets[myList, {3}]},
 Pick[p, And @@@ 
   Table[(Length@Intersection[#, p[[i]]] < 2) & /@ existingGroups, {i,
      1, Length[p]}]]]

Answer 2

A quick follow-up to my comment question (don't know if useful if only trivially small cases are of import to you).

With tasks like this (generation followed by filtering), one should ask "Can I reduce the filtering?" - either by minimizing that to be filtered, improving the efficiency of filtering, or both, and even more so, "Can I eliminate filtering and generate the desired results directly?".

Here's a couple of tacks along those lines:

fn[lst_, exi_] := Module[{tr, f, a1, a2, a3},
  tr = Append[#, _] & /@ Join @@ (Subsets[#, {2}] & /@ exi);
  SetAttributes[f, Orderless];
  f[a1_, a2_, a3_] = {a1, a2, a3};
  (f[Sequence @@ #] = Unevaluated@Sequence[];) & /@ tr;
  f @@@ lst];

gen = Module[{pp = Partition[#, 3, 3, {1, 1}, {}], t}, 
    t = Sort@Flatten[Tuples /@ Subsets[pp, {3}], 1];
    If[Length@Last@pp == 2, 
     Sort@Join[t, Tuples[{Flatten[Most@pp], Sequence @@ Transpose[{Last@pp}]}]], 
     t]] &;

fn is completely generalized, that is, given some list of elements and a list of existing sets, it generates the 3-tuples of the elements that share at most one element with any of the existing sets. It handles existing sets of arbitrary size members, and if other than 3-tuple results are desired, easily adapted.

gen generates the example results (3-tuples from a list of elements where existing sets are defined as the 3-partitions of the list as in your example) from a target list. Again, pretty easily adapted to other output needs.

A brief performance comparison using OP example output against lists 10-80 in length (on loungebook, so 10+X faster on workstation):

We can see fn is better than an order of magnitude faster than using the Table/Intersection method, and gen is better than an order of magnitude faster yet. The latter also has a superior growth rate (a bit hard to discern on the plot) - roughly linear with result size, while the others are quite a bit worse...