[Haskell-cafe] Collection of sets containing no sets which are a subset of another in the collection

[Mark Wassell]

Hi,

I am looking for a data structure that will represent a collection of 
sets such that no element in the collection is a subset of another set. 
In other words, inserting an element that is already a subset of another 
element will return the original collection, and inserting an element 
that is a superset of any elements will result in a collection with the 
superset added and the subsets removed.

What I have so far is the below but I am wondering if there has been any 
prior work on this (particularly using Haskell but also conceptual 
work). Inserting a set that is a subset is easy to handle, inserting a 
superset and remove subsets of it is a little tricker.

Cheers

Mark


module SetTrie where

--
-- A set of sets which does not contain elements which are subsets of 
any other element.
-- ie insert a element which is a proper subset of another set returns 
the same set of sets
--    insert a element which is a proper superset of one or more 
elements causes those elements to be removed
--     (and the first element to be added)
--


import Data.Set hiding (toList,singleton,map,insert)
import Data.Map hiding 
(fromList,showTreeWith,toAscList,toList,singleton,map,insert)
import qualified Data.Map as M (toList,fromList,lookup,insert)
import qualified Data.Set as S (toList,fromList)



-- Normally we would have a flag at a node to indicate a subset is 
there, but we
-- don't store subsets.


data SetTrie a = Leaf [a] | Node (Map a (SetTrie a)) deriving (Show,Eq)

singleton :: Ord a => Set a -> SetTrie a
singleton = Leaf . S.toList

toList' :: Ord a => SetTrie a -> [[a]]
toList' (Leaf xs) = [xs]
toList' (Node m) = concatMap (\(x,y) -> map (x:) (toList' y)) $ M.toList m

toList :: Ord a => SetTrie a -> [Set a]
toList x = map S.fromList $ toList' x

insert :: Ord a => SetTrie a -> Set a -> SetTrie a
insert t s = insert' t $ toAscList s

insert':: Ord a => SetTrie a -> [a] -> SetTrie a
insert' (Leaf (y:ys)) (x:xs) = Node (M.fromList [(y,Leaf ys),(x,Leaf xs)])
insert' (Node m) (x:xs) = case M.lookup x m of
                                 Nothing -> case xs of
                                               [] -> Node $ M.insert x 
(Leaf xs) m
                                               _ ->  Node $ M.insert x 
(Leaf xs) m
                                 Just t' -> case xs of
                                               [] -> Node m
                                               _ ->  Node $ M.insert x 
(insert' t' xs) m

-- removeSubsets ::

-- terminate (Node m) = Node mTrue m
-- terminate (Leaf (x:xs)) = Node True (M.fromList [(x,Leaf xs)])


s1 = fromList [1,2,3,5,2]
s2 = fromList [2,3,5]

t1 = Node (M.fromList [(1,Leaf [2]),(3,Leaf [5]),(2,Node (M.fromList 
[(4,Leaf [6])]))])

t2 = insert (singleton (S.fromList [1])) $ S.fromList [1,2,3]

t3 = insert t1 $ S.fromList [2,4,7]

t4 = insert t2 $ S.fromList [1]

t5 = insert t3 $ S.fromList [2,5]

t6 = insert t5 $ S.fromList [2,4]

-- Now add a superset of everything
t7 = insert (singleton (S.fromList [8])) $ S.fromList [1,2,3,4,5,6,7,8,9]


Mark