/r/dailyprogrammer #196 in Haskell by /u/teslatronic

GHCI example

λ> :m Set
λ> let a = fromList [1,4,7]
λ> let b = fromList [-4, 7, 10]
λ> a `union` b
  {1,4,7,-4,10}
λ> a `intersect` b
  {7}
λ> let a' = complement a
λ> 7 `member` a'
  Interrupted. -- Goes on forever, since elem needs to look through the whole list.

Set.hs

{-# LANGUAGE GADTs #-}

module Set
( Set(Empty)
, fromList
, toList
, member
, (∈)
, (∉)
, union
, (∪)
, intersect
, (∩)
, complement
) where

import qualified Data.List as L

data Set a where
    Set :: (Eq a, Show a) => [a] -> Set a
    Empty :: Set a

instance Show (Set a) where
    show Empty =  "{}"
    show (Set xs) = "{" ++ (tail . init . show $ xs) ++ "}"

instance Eq (Set a) where
    Set xs == Set ys = all (`elem` ys) xs && all (`elem` xs) ys
    Empty == _ = False
    _ == Empty = False

fromList :: (Eq a, Show a) => [a] -> Set a
fromList [] = Empty
fromList xs = Set (L.nub xs)

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

member :: a -> Set a -> Bool
member x Empty = False
member x (Set xs) = x `elem` xs

(∈) = member
(∉) = (not .) . member

union :: Set a -> Set a -> Set a
union Empty x = x
union x Empty = x
union (Set xs) (Set ys) = fromList (L.union xs ys)

(∪) = union

intersect :: Set a -> Set a -> Set a
intersect Empty _ = Empty
intersect _ Empty = Empty
intersect (Set xs) (Set ys) = fromList (L.intersect xs ys)

(∩) = intersect

complement :: Set Integer -> Set Integer
complement (Set xs) = Set $ filter (`notIn` xs) ns where
    ns = 0 : [y | x <- [1..], y <- [x, -x]]
    -- This means the complement of a set contains an infinite list,
    -- and therefore it's not printable. But it's still the complement. :p
    notIn = \x -> \ys -> not (x `elem` ys)

SetInt.hs

-- Simple version using only Integer
{-# LANGUAGE GADTs #-}

module Set where

import qualified Data.List as L

data Set where
    Set :: [Integer] -> Set
    Empty :: Set

instance Show Set where
    show Empty =  "{}"
    show (Set xs) = "{" ++ (tail . init . show . L.sort $ xs) ++ "}"

instance Eq Set where
    Set xs == Set ys = all (`elem` ys) xs && all (`elem` xs) ys
    Empty == _ = False
    _ == Empty = False

fromList :: [Integer] -> Set
fromList [] = Empty
fromList xs = Set (L.nub xs)

member :: Integer -> Set -> Bool
member x Empty = False
member x (Set xs) = x `elem` xs

(∈) = member
(∉) = not . member

union :: Set -> Set -> Set
union Empty x = x
union x Empty = x
union (Set xs) (Set ys) = fromList (L.union xs ys)

(∪) = union

intersect :: Set -> Set -> Set
intersect Empty _ = Empty
intersect _ Empty = Empty
intersect (Set xs) (Set ys) = fromList (L.intersect xs ys)

(∩) = intersect