-- # Software Tools for Discrete Mathematics
module Stdm08SetTheory where

import Stdm06LogicOperators

-- # Chapter 8.  Set Theory

type Set a = [a]

errfun :: (Show a) => String -> a -> String -> b
errfun f s msg = error (f ++ ": " ++ show s ++ " is not a " ++ msg)

-- | Note that subset does not reject non-sets
-- >>> subset [1,2] [1,2]
-- True
subset :: (Eq a, Show a) => Set a -> Set a -> Bool
subset set1 set2 =
  foldr f True set1
  where
    f x sofar = if elem x set2 then sofar else False

-- | Note that properSubset does not reject non-sets
-- properSubset [1,2] [1,2,3]
-- True
properSubset :: (Eq a, Show a) => Set a -> Set a -> Bool
properSubset set1 set2 =
  not (setEq set1 set2) /\ (subset set1 set2)

-- | Note that setEq does not reject non-sets
-- >>> setEq [1,2] [2,1]
-- True
setEq :: (Eq a, Show a) => Set a -> Set a -> Bool
setEq set1 set2 =
  (set1 `subset` set2) /\ (set2 `subset` set1)

-- |
-- >>> normalForm [1,1,2,2,3,3]
-- False
normalForm :: (Eq a, Show a) => [a] -> Bool
normalForm set = length (normalizeSet set) == length set

-- |
-- >>> normalizeSet [1,1,2,2,3,3]
-- [1,2,3]
normalizeSet :: (Eq a) => [a] -> Set a
normalizeSet elts =
  foldr f [] elts
  where
    f x sofar =
      if x `elem` sofar then sofar else x : sofar

-- | Union
-- >>> [1,2] +++ [2,3]
-- [1,2,3]
infix 3 +++

(+++) :: (Eq a, Show a) => Set a -> Set a -> Set a
(+++) set1 set2 =
  if not (normalForm set1)
    then errfun "+++" set1 "set"
    else
      if not (normalForm set2)
        then errfun "+++" set2 "set"
        else normalizeSet (set1 ++ set2)

-- | Intersection
-- >>> [1,2] *** [2,3]
-- [2]
infix 4 ***

(***) :: (Eq a, Show a) => Set a -> Set a -> Set a
(***) set1 set2 =
  if not (normalForm set1)
    then errfun "***" set1 "set"
    else
      if not (normalForm set2)
        then errfun "***" set2 "set"
        else [x | x <- set1, (x `elem` set2)]

-- | Difference
-- >>> [1,2] ~~~ [2,3]
-- [1]
infix 4 ~~~

(~~~) :: (Eq a, Show a) => Set a -> Set a -> Set a
(~~~) set1 set2 =
  if not (normalForm set1)
    then errfun "~~~" set1 "set"
    else
      if not (normalForm set1)
        then errfun "~~~" set2 "set"
        else [x | x <- set1, not (x `elem` set2)]

-- | Complement
-- >>> [1..10] ~~~ [1]
-- [2,3,4,5,6,7,8,9,10]
infix 5 !!!

(!!!) :: (Eq a, Show a) => Set a -> Set a -> Set a
(!!!) u a =
  if not (normalForm u)
    then errfun "!!!" u "set"
    else
      if not (normalForm a)
        then errfun "!!!" a "set"
        else u ~~~ a

-- |
-- >>> powerset [1..3]
-- [[1,2,3],[1,2],[1,3],[1],[2,3],[2],[3],[]]
powerset :: (Eq a, Show a) => Set a -> Set (Set a)
powerset set =
  if not (normalForm set)
    then errfun "powerset" set "set"
    else powersetLoop set
  where
    powersetLoop [] = [[]]
    powersetLoop (e : set) =
      let setSoFar = powersetLoop set
       in [e : s | s <- setSoFar] ++ setSoFar

-- |
-- >>> crossproduct ["a","b"] [1,2,3]
-- [("a",1),("a",2),("a",3),("b",1),("b",2),("b",3)]
crossproduct ::
  (Eq a, Show a, Eq b, Show b) =>
  Set a ->
  Set b ->
  Set (a, b)
crossproduct set1 set2 =
  if not (normalForm set1)
    then errfun "crossproduct" set1 "set"
    else
      if not (normalForm set2)
        then errfun "crossproduct" set2 "set"
        else [(a, b) | a <- set1, b <- set2]