Hi Sander, good point on replace. I noticed that the Subset is not very fast. A speed up could also be made to hardcode subsets using compile (up to 10 items since it’s the max) but that is a lot of work and probably not worth it. The dataset David posted is already cleaned up in 2.5 seconds on my system. This was fun!

Hi David, I would be honoured. Glad we could help you out.

Hi Richard, I had some time left to experiment with another approach. This works due to the limited length of the subsets. My approach is basically trying to solve in one pass this puzzle. I calculate the possible subsets and label them with Primes and then delete the subsets if present in an association database (db). The benefit of this approach is that it it also handles the duplicates I was talking about. I tested Sander's routine with 100000 subsets and it solved in 670 seconds. My routine did this in 64 seconds. I tested this by removing any duplicates in the testset to be sure to get the same results as Sanders approach.

ss = RandomChoice[words, {100000, 10}];
ss = Table[Take[s, RandomInteger[{1, Length[s]}]], {s, ss}];
ss = DeleteDuplicates /@ ss;
ss = Sort /@ SortBy[ss, Length];

RemoveSubsetsv2[subsets_] := 
 Module[{data, uniquedata, uniquerules, db, step},
  data = Gather /@ subsets;
  uniquedata = SortBy[DeleteDuplicates@Flatten[data, 1], Length];
  uniquerules = 
   Dispatch[
    Flatten[{Thread[
       uniquedata -> Rest@Prime@(Range[Length@uniquedata + 1])],
      Thread[
       Rest@Prime@(Range[Length@uniquedata + 1]) -> uniquedata]}, 
     1]];
  db = Times @@ # -> # & /@ (data /. uniquerules) // Association;
  step = 0;
  PrintTemporary[Dynamic[step]];
  (step++; 
     KeyDropFrom[db, 
      Rest@ReverseSort@
        MapApply[Times, 
         DeleteDuplicates[(Gather /@ Subsets[#]) /. 
           uniquerules]]]) & /@ ReverseSortBy[subsets, Length];
  SortBy[Flatten /@ (Values@db /. uniquerules), Length]
  ]

RemoveSubsetsv2[{{"a"}, {"a", "a", "b", "b", "c"}, {"a", "a"}, {"a", 
   "a", "b", "b", "a", "c"}, {"c", "b", "b", "b", "a", 
   "a"}, {"b"}, {"a", "b"}, {"a", "a", "a", "a"}, {"c"}}]

{{"a", "a", "a", "a"}, {"a", "a", "a", "b", "b", "c"}, {"c", "b", "b", "b", "a", "a"}}

RemoveSubsets[{{"a"}, {"a", "a", "b", "b", "c"}, {"a", "a"}, {"a", 
   "a", "b", "b", "a", "c"}, {"c", "b", "b", "b", "a", 
   "a"}, {"b"}, {"a", "b"}, {"a", "a", "a", "a"}, {"c"}}]

{{"a", "a", "b", "b", "b", "c"}}

Would love to hear how it works on your real data.

Yeah I was also thinking of using Primes or numbers in ‘fancy’ bases like you did but thought it would be slower. You proved me wrong. You could probably still speed it up a bit by using Replace with a level spec rather than /. ReplaceAll which does all levels by default. Not sure if it speeds up a lot since you’re using Dispatch already… I built mine explicitly assuming multiplicities don’t matter.

Yes so realize that the method provided from Sander's algo will be

RemoveSubsets[{{"A", "A", "B", "B"}, {"A", "A", "B", "B", "B"}, {"A", "A", "A", "B", "B"}}]

{"A", "A", "B", "B", "B"}

Hi Richard, Just wondering. Are there in the subsets any duplicate strings?

Thx Richard, How would you solve a set like: ss = {{"A", "A", "A", "A", "A", "A"}, {"A", "B"}, {"B"}, {"A", "A", "A", "B"}, {"A", "A", "A", "A", "B"}, {"A", "A", "B", "A"}, {"A", "A", "D"}} Sanders solution (Nice!) is {{"A", "A", "A", "A", "A", "A"}, {"A", "B"}, {"B"}, {"A", "A", "A", "B"}, {"A", "A", "A", "A", "B"}, {"A", "A", "B", "A"}, {"A", "A", "D"}}

and for: {{"A"}, {"A", "A"}, {"A", "A", "A"}, {"A", "A", "A", "A"}, {"A", "A", "A", "A", "A"}, {"A", "A", "A", "A", "A", "A"}, {"A", "A", "A", "A", "A", "A", "A"}, {"A", "A", "A", "A", "A", "A", "A", "A"}, {"A", "A", "A", "A", "A", "A", "A", "A", "A"}, {"A", "A", "A", "A", "A", "A", "A", "A", "A", "A"}}

you get {{"A", "A", "A", "A", "A", "A", "A", "A", "A", "A"}}

Is that what you need or could above also resolve to just {"A"}

For the supersets of "A"'s you list, a reduction to a single "A" represents a reduction to primaries. It is something I've had occassion to use when analyzing repeating motifs in an entire chromosome.

But for the present, Sander has provided exactly what I wanted: fast elimination of subsets. The reason for doing so is born out of the application area. In particular, I am trying to determine which elements of IAS-OLI16 are causing it to fluoresce with O. europaea in PCR tests. (https://www.genome.gov/about-genomics/fact-sheets/Polymerase-Chain-Reaction-Fact-Sheet)

Hi Sander, consider this list of String sets:

{
{"ATGA"},
{"GAGAC","TTTA"},
{"ATGA","TTTA"},
{"AAAAAT","GCGAGAA"},
{"AAAAAT","GAGCC","GCGAGAA"}
}

The first is a subset of the third and the fourth is a subset of the fifth, so after filtering the result would be:

{
{"GAGAC","TTTA"},
{"ATGA","TTTA"},
{"AAAAAT","GAGCC","GCGAGAA"}
}

Sander, thank you for your suggestions. Your recommendation to replace the String elements with indices is very good -- something I completely overlooked. Trying it in my algorithm, it reduces the elapsed time by 25%. I've yet to try your algorithm though. I will do so tonight and report back tomorrow.

Please double-check if it works properly, I was unable to check deeply. I play around with the index i a bit, and I think I got it correct. But it always feels a bit strange to do this manual work.

The main idea is:

Scan from large to small (so in reverse). Then for this element i, make a pattern that matches any subset of that element i. Find the position of the elements 1 through i-1 that matches the pattern (using the Position function). Delete those. Now update the index i because we delete stuff 'in front of' the current element. Since you start with the biggest sets first, this will (potentially) delete the most stuff, and after each iteration the number of items to scan decreases because i decreases, and because elements are deleted.

Still a n^2 algorithm though. It might be solveable in a neat way by using hypergraph but I'm not sure if Mathematica is set-up for that at the moment, and whether this is possible memory-wise for list of 10^5 elements and above.

Of course you can acknowledge me :-)

I'll think about turning this into a Wolfram Function Repository function in the future…