Hybrid Mathematica - Java solution
Since the top-level solution from EDIT is still rather slow, here is a Java port of it.
To use it, you have to first load the Java reloader into your session.
Code
Having done that, we have to compile this class:
JCompileLoad@"import java.util.*;
public class MinSubsets{
public static Object[] getMinimalSubsets(int[] lsortedflat,
int[] lengths){
int[][] lsorted = new int[lengths.length][];
int ctr = 0;
for(int i=0;i<lengths.length;i++){
lsorted[i] = new int[lengths[i]];
for(int j=0;j<lengths[i];j++){
lsorted[i][j] = lsortedflat[ctr++];
}
}
int[] positions = new int[lsorted.length];
for(int i=0;i<lsorted.length;i++){
positions[i]=i;
}
Map<Integer,Set<Integer>> hash = new HashMap<Integer,Set<Integer>>();
for(int i=0;i<lsorted.length;i++){
for(int elem:lsorted[i] ){
if(!hash.containsKey(elem)){
hash.put(elem,new HashSet<Integer>());
}
hash.get(elem).add(i);
}
}
List<int[]> aux = new ArrayList<int[]>();
for(int i=0;i<lsorted.length;i++){
if(positions[i]==-1) continue;
Set<Integer> containing =
new HashSet<Integer>(hash.get(lsorted[i][0]));
for(int j = 1; j<lsorted[i].length;j++){
containing.retainAll(hash.get(lsorted[i][j]));
}
for(int elem : lsorted[i]){
hash.get(elem).removeAll(containing);
}
for(int pos : containing){
if( pos == i)continue;
positions[pos]=-1;
}
aux.add(lsorted[i]);
}
return aux.toArray();
}
}"
Now, here is the Mathematica part:
ClearAll[getMinSubsets];
getMinSubsets[l : {{__Integer} ..}] :=
With[{sorted = Sort@l},
MinSubsets`getMinimalSubsets[Flatten[sorted ], Length /@ sorted]
];
getMinSubsets[l_List] :=
With[{rules =
Thread[# -> Range[Length[#]]] &[DeleteDuplicates[Flatten[l]]]
},
Map[ Developer`ToPackedArray,
getMinSubsets[l /. Dispatch[rules]]
] /. Dispatch[Reverse[rules, {2}]]
];
The idea is that for integer elements, I send a flattened list of them to Java plus the list of the lengths of subsets, while for general elements I first map unique elements to inetegers, then do the same thing, then map those back.
Tests and benchmarks
For our test example:
getMinSubsets[sets]
(* {{a, b}, {b, c}, {a, c, e}, {a, e, d, f}} *)
Now, the real sample (you will need to load the definiton of selectMinimalHT
below, and also Heike's minSubsets
, for comparison:
(res=getMinSubsets [ randomSets])//Length//AbsoluteTiming
(res1=selectMinimalHT[randomSets ])//Length//AbsoluteTiming
(res2 = minSubsets[randomSets ])//Length//AbsoluteTiming
res==res1==res2
(*
{0.8750000,1177}
{7.4492188,1177}
{63.5615234,1177}
True
*)
Conclusions
Depending on the data (how large are subsets on the average, and how big is a fraction of subsets containing other subsets), the hybrid Java - Mathematica solution can be 10-20 times faster than top-level Mathematica solution, and 50-100 times faster than Heike's one-liner, which I believe is the fastest of other posted solutions (the truth is that her and other posted solutions have quadratic complexity in the size of the subset list, so the larger it is, the more dramatic will be the performance difference).
EDIT The solution of @Mr.Wizard is actually the fastest top-level Mathematica solution, being only 1.5 times slower than this Java one, but also much shorter and more memory efficient END EDIT
This shows once again what can be a successful optimization path: prototype the algorithm in Mathematica first, get the asymptotic complexity right, and then move heavy part to Java.
The Java solution is also memory-hungry, like my Mathematica top-level one (and unlike Heike's solution which is very memory-efficient). So, for truly large lists, one may have to proceed iteratively, and / or also have lots of RAM available.
In any case, this Java solution may be fast enough to process your real sets in realistic time.
Top - level optimized solution using nested hash tables (used in the above Java solution as a prototype)
EDIT Apparently @Mr.Wizard's latest code is much faster than this and also
much shorter END EDIT
Since you mentioned that you need to process rather large lists of subsets, I tried to optimize my code. Here is the fastest top-level implementation I was able to come up with:
Clear[selectMinimalHT];
selectMinimalHT[sets_List] :=
Module[{hash, sorted = Transpose[{#, Range@Length@#} &@Sort@sets],
result},
Do[hash[elem] = Unique[], {elem, Union@Flatten@sets}];
Reap[Sow[#, First@#] & /@ sorted, _,
Do[hash[#1][set] = True, {set, #2}] &
];
result =
Reap[Do[
If[sorted[[i]] == {}, Continue[]];
Sow[sorted[[i, 1]]];
With[{containing =
Apply[Intersection,
Map[
With[{sym = hash[#]},
DownValues[sym, Sort -> False][[All, 1, 1, 1]]
] &,
sorted[[i, 1]]
]
]},
Do[
With[{sym = hash[elem]},
If[ValueQ[sym[set]], Unset[sym[set]]]
],
{set, containing},
{elem, First@set}
];
sorted[[containing[[All, 2]]]] = {};
], (* With *)
{i, Length[sorted]}
]
][[2, 1]];
Remove @@ DownValues[hash][[All, 1, 1]];
result
];
This is based on nested hash-tables, which are modified at run-time, but other than that, it is the same algorithm as in my original code. But, using hash-tables allows me to avoid requent copying of large lists, and, more importantly, the rules telling us which subsets are still potentially valid are updated at each step, which wasn't the case for Dispath
-based rules. This allows to at least have a good asymptotic complexity, although perhaps with a large constant factor coming from a large overhead of top-level Mathematica code.
You use is as:
selectMinimalHT[sets]
(* {{a, b}, {b, c}, {a, c, e}, {a, e, d, f}} *)
Here is a more realistic sample:
randomSets =
Table[RandomSample[#,RandomInteger[{3,Length[#]}]]&@Range[100],{50000}];
selectMinimalHT[randomSets]//Short//AbsoluteTiming
(*
{93.8876953,{{1,15,24},<<4703>>,
{14,70,12,9,31,90,18,65,64,92,26,48,84,57,62,1,76,7,2,4,44,67,22}}}
*)
The complexity is approximately n*l
, where n
is the size of the list, and l
is the average size of a subset. Note that this solution becomes quite memory-hungry, so you may want to split your list in chunks and feed those iteratively to it, combining the result with the remainder to obtain a list to be used in a new iteration.
If your subset elements are numbers, the code can be significantly sped up, by, e.g., porting the above algorithm to Java (Mathematica's Compile
won't do since we need hash tables).
Initial moderately fast solution
I think, the following will be reasonably fast (although, perhaps, not the fastest):
Clear[selectMinimal]
selectMinimal[sets_List] :=
With[{rules = Dispatch[Reap[Sow[#, #] & /@ sets, _, Rule][[2]]]},
If[# === {}, {}, First@#] &@
Reap[
NestWhile[
With[{set = Sow@First@#},
Complement[Rest@#, Apply[Intersection, set /. rules]]
] &,
Sort[sets],
# =!= {} &]
][[2]]
];
In your case, you use it as
selectMinimal[sets]
(* {{a, b}, {b, c}, {a, c, e}, {a, e, d, f}} *)
For some larger example, I will generate a large list of random subsets of another list:
randomSets =
Table[RandomSample[#, RandomInteger[{3, Length[#]}]] &@ Range[30], {1000}];
I get then
selectMinimal[randomSets]//Short//AbsoluteTiming
{0.3535156,{{1,15,10},{2,30,11},<<182>>,{22,5,9,4,2,13,24,21,11,10,27},
{27,30,11,5,8,29,28,18,14,15,21}}}