-------------------------------------------------------------------------
-- 
--         Set.hs   
--
--         ADT of sets, implemented as ordered lists without repetitions.   
--  
--         (c) Addison-Welsey, 1996-2011.                   
--        
---------------------------------------------------------------------------

module Set ( Set ,
  empty              , -- Set a
  sing               , -- a -> Set a
  memSet             , -- Ord a => Set a -> a -> Bool
  union,inter,diff   , -- Ord a => Set a -> Set a -> Set a
  eqSet              , -- Eq a  => Set a -> Set a -> Bool
  subSet             , -- Ord a => Set a -> Set a -> Bool
  makeSet            , -- Ord a => [a] -> Set a
  mapSet             , -- Ord b => (a -> b) -> Set a -> Set b
  filterSet          , -- (a -> Bool) -> Set a -> Set a
  foldSet            , -- (a -> a -> a) -> a -> Set a -> a
  showSet            , -- (a -> String) -> Set a -> String
  card               , -- Set a -> Int
  flatten              -- Set a -> [a]
  ) where

import Data.List hiding ( union )
--  
-- Instance declarations for Eq and Ord                 

instance Eq a => Eq (Set a) where
  == :: Set a -> Set a -> Bool
(==) = Set a -> Set a -> Bool
forall a. Eq a => Set a -> Set a -> Bool
eqSet

instance Ord a => Ord (Set a) where
  <= :: Set a -> Set a -> Bool
(<=) = Set a -> Set a -> Bool
forall a. Ord a => Set a -> Set a -> Bool
leqSet

-- The implementation.                      
--              
newtype Set a = Set [a]

empty :: Set a
empty :: forall a. Set a
empty  = [a] -> Set a
forall a. [a] -> Set a
Set []

sing :: a -> Set a
sing :: forall a. a -> Set a
sing a
x = [a] -> Set a
forall a. [a] -> Set a
Set [a
x]

memSet :: Ord a => Set a -> a -> Bool
memSet :: forall a. Ord a => Set a -> a -> Bool
memSet (Set []) a
y    = Bool
False
memSet (Set (a
x:[a]
xs)) a
y 
  | a
xa -> a -> Bool
forall a. Ord a => a -> a -> Bool
<a
y     = Set a -> a -> Bool
forall a. Ord a => Set a -> a -> Bool
memSet ([a] -> Set a
forall a. [a] -> Set a
Set [a]
xs) a
y
  | a
xa -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
y    = Bool
True
  | Bool
otherwise   = Bool
False

union :: Ord a => Set a -> Set a -> Set a
union :: forall a. Ord a => Set a -> Set a -> Set a
union (Set [a]
xs) (Set [a]
ys) = [a] -> Set a
forall a. [a] -> Set a
Set ([a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
uni [a]
xs [a]
ys)

uni :: Ord a => [a] -> [a] -> [a]
uni :: forall a. Ord a => [a] -> [a] -> [a]
uni [] [a]
ys        = [a]
ys
uni [a]
xs []        = [a]
xs
uni (a
x:[a]
xs) (a
y:[a]
ys) 
  | a
xa -> a -> Bool
forall a. Ord a => a -> a -> Bool
<a
y     = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
uni [a]
xs (a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ys)
  | a
xa -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
y    = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
uni [a]
xs [a]
ys
  | Bool
otherwise   = a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
uni (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs) [a]
ys

inter :: Ord a => Set a -> Set a -> Set a
inter :: forall a. Ord a => Set a -> Set a -> Set a
inter (Set [a]
xs) (Set [a]
ys) = [a] -> Set a
forall a. [a] -> Set a
Set ([a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
int [a]
xs [a]
ys)

int :: Ord a => [a] -> [a] -> [a]
int :: forall a. Ord a => [a] -> [a] -> [a]
int [] [a]
ys = []
int [a]
xs [] = []
int (a
x:[a]
xs) (a
y:[a]
ys) 
  | a
xa -> a -> Bool
forall a. Ord a => a -> a -> Bool
<a
y     = [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
int [a]
xs (a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ys)
  | a
xa -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
y    = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
int [a]
xs [a]
ys
  | Bool
otherwise   = [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
int (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs) [a]
ys

diff :: Ord a => Set a -> Set a -> Set a
diff :: forall a. Ord a => Set a -> Set a -> Set a
diff (Set [a]
xs) (Set [a]
ys) = [a] -> Set a
forall a. [a] -> Set a
Set ([a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
dif [a]
xs [a]
ys)

dif :: Ord a => [a] -> [a] -> [a]
dif :: forall a. Ord a => [a] -> [a] -> [a]
dif [] [a]
ys = []
dif [a]
xs [] = [a]
xs
dif (a
x:[a]
xs) (a
y:[a]
ys)  
  | a
xa -> a -> Bool
forall a. Ord a => a -> a -> Bool
<a
y     = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
dif [a]
xs (a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ys)
  | a
xa -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
y    = [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
dif [a]
xs [a]
ys
  | Bool
otherwise   = [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
dif (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs) [a]
ys

subSet :: Ord a => Set a -> Set a -> Bool
subSet :: forall a. Ord a => Set a -> Set a -> Bool
subSet (Set [a]
xs) (Set [a]
ys) = [a] -> [a] -> Bool
forall a. Ord a => [a] -> [a] -> Bool
subS [a]
xs [a]
ys

subS :: Ord a => [a] -> [a] -> Bool
subS :: forall a. Ord a => [a] -> [a] -> Bool
subS [] [a]
ys = Bool
True
subS [a]
xs [] = Bool
False
subS (a
x:[a]
xs) (a
y:[a]
ys) 
  | a
xa -> a -> Bool
forall a. Ord a => a -> a -> Bool
<a
y     = Bool
False
  | a
xa -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
y    = [a] -> [a] -> Bool
forall a. Ord a => [a] -> [a] -> Bool
subS [a]
xs [a]
ys
  | a
xa -> a -> Bool
forall a. Ord a => a -> a -> Bool
>a
y     = [a] -> [a] -> Bool
forall a. Ord a => [a] -> [a] -> Bool
subS (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs) [a]
ys

eqSet :: Eq a => Set a -> Set a -> Bool
eqSet :: forall a. Eq a => Set a -> Set a -> Bool
eqSet (Set [a]
xs) (Set [a]
ys) = ([a]
xs [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== [a]
ys)

leqSet :: Ord a => Set a -> Set a -> Bool
leqSet :: forall a. Ord a => Set a -> Set a -> Bool
leqSet (Set [a]
xs) (Set [a]
ys) = ([a]
xs [a] -> [a] -> Bool
forall a. Ord a => a -> a -> Bool
<= [a]
ys)

--          
makeSet :: Ord a => [a] -> Set a
makeSet :: forall a. Ord a => [a] -> Set a
makeSet = [a] -> Set a
forall a. [a] -> Set a
Set ([a] -> Set a) -> ([a] -> [a]) -> [a] -> Set a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall {a}. Ord a => [a] -> [a]
remDups ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall {a}. Ord a => [a] -> [a]
sort
          where
          remDups :: [a] -> [a]
remDups []     = []
          remDups [a
x]    = [a
x]
          remDups (a
x:a
y:[a]
xs) 
            | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
y     = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a]
remDups (a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs)
            | Bool
otherwise = [a] -> [a]
remDups (a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs)

mapSet :: Ord b => (a -> b) -> Set a -> Set b
mapSet :: forall b a. Ord b => (a -> b) -> Set a -> Set b
mapSet a -> b
f (Set [a]
xs) = [b] -> Set b
forall a. Ord a => [a] -> Set a
makeSet ((a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
f [a]
xs)

filterSet :: (a -> Bool) -> Set a -> Set a
filterSet :: forall a. (a -> Bool) -> Set a -> Set a
filterSet a -> Bool
p (Set [a]
xs) = [a] -> Set a
forall a. [a] -> Set a
Set ((a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter a -> Bool
p [a]
xs)

foldSet :: (a -> a -> a) -> a -> Set a -> a
foldSet :: forall a. (a -> a -> a) -> a -> Set a -> a
foldSet a -> a -> a
f a
x (Set [a]
xs)  = ((a -> a -> a) -> a -> [a] -> a
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> a -> a
f a
x [a]
xs)

showSet :: (a->String) -> Set a -> String
showSet :: forall a. (a -> String) -> Set a -> String
showSet a -> String
f (Set [a]
xs) = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((a -> String) -> [a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\n") (String -> String) -> (a -> String) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
f) [a]
xs)

card :: Set a -> Int
card :: forall a. Set a -> Int
card (Set [a]
xs)     = [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs

-- Breaks the abstraction: used in Relation:

flatten :: Set a -> [a]
flatten (Set [a]
xs) = [a]
xs