-- # 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 :: (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 :: (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 :: (Eq a, Show a) => Set a -> Set a -> Bool
setEq set1 set2 =
  (set1 `subset` set2) /\ (set2 `subset` set1)

normalForm :: (Eq a, Show a) => [a] -> Bool
normalForm set = length (normalizeSet set) == length set

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

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)

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)]

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)]

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 :: (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 ::
  (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]