Discrete Mathematics Using a Computer Chapter 08: Sets Solutions

DiscreteMathComputer08.hs

{- Discrete Mathematics Using a Computer
   Chapter 08: Sets
-}

module Sets where

type Set a = [a]
-- Note, this definition prevents us from having heterogeneous sets
-- TODO: use hlist (http://homepages.cwi.nl/~ralf/HList/) ?

--------------------------------------------------------------------------------
-- The Null Set: contains no elements

nullSet :: Set a
nullSet = []

--------------------------------------------------------------------------------
-- Membership
-- x \in A means the item x is contained in the set A
-- in haskell, can use elem :: (Eq a) => a -> [a] -> Bool

myElem :: (Eq a) => a -> Set a -> Bool
myElem x = foldr ((||) . (== x)) False

-- *Sets> myElem 1 []
-- False
-- *Sets> myElem 1 [1..10]
-- True
-- *Sets> myElem 1 (reverse [1..10])
-- True

--------------------------------------------------------------------------------
-- Set builder notation in Haskell
-- {x \in \mathbb{N} | p x} <=> [x | x <- N, p x]
-- {2 * x | x \in \mathbb{N}, p x} <=> [2 * x | x <- N, p x]

--------------------------------------------------------------------------------
-- Subset
-- Suppose A and B are sets
-- A is a subset of B if each element of A also appears in B

isSubset :: (Eq a) => Set a -> Set a -> Bool
isSubset xs ys = all (`myElem` ys) xs

-- *Sets> isSubset [] [1..10]
-- True
-- *Sets> isSubset [1..10] []
-- False
-- *Sets> isSubset [1..5] [1..10]
-- True

equalSets  :: (Eq a) => Set a -> Set a -> Bool
equalSets xs ys = isSubset xs ys && isSubset ys xs

properSubset :: (Eq a) => Set a -> Set a -> Bool
properSubset xs ys = isSubset xs ys && (not $ isSubset ys xs)

-- *Sets> properSubset [1..5] [1..10]
-- True
-- *Sets> properSubset [1..10] [1..10]
-- False
-- *Sets> properSubset [] [1]
-- True

--------------------------------------------------------------------------------
-- Ensuring that sets don't have duplicates:

normalForm :: Eq a => Set a -> Bool
normalForm xs = length xs == length (normalizeSet xs)

normalizeSet :: Eq a => Set a -> Set a
normalizeSet = foldr setAdd []
  where setAdd new acc = if new `myElem` acc then acc else new : acc

-- *Sets> normalizeSet ([1..10] ++ [1..10])
-- [1,2,3,4,5,6,7,8,9,10]
-- *Sets> normalForm []
-- True
-- *Sets> normalForm $ [1..10] ++ [1..10]
-- False
-- *Sets> normalForm [1..10]
-- True
-- *Sets> 

--------------------------------------------------------------------------------
-- Set operations

union :: Eq a => Set a -> Set a -> Set a
union xs = foldr setAdd xs
  where setAdd new acc = if new `elem` acc then acc else new : acc

-- *Sets> union [1..10] [11..20]
-- [11,12,13,14,15,16,17,18,19,20,1,2,3,4,5,6,7,8,9,10]
-- *Sets> union [1..10] [1..10]
-- [1,2,3,4,5,6,7,8,9,10]

intersection :: Eq a => Set a -> Set a -> Set a
intersection xs = foldr intersect []
  where intersect new acc = if new `elem` xs then new:acc else acc
        
-- *Sets> intersection [1..10] [5..15]
-- [5,6,7,8,9,10]
-- *Sets> intersection [] []
-- []
-- *Sets> intersection [] [1..10]
-- []
-- *Sets> intersection [1..10] [1..10]
-- [1,2,3,4,5,6,7,8,9,10]
  
difference :: Eq a => Set a -> Set a -> Set a
difference xs ys = foldr diff [] xs
  where diff new acc = if new `elem` ys then acc else new:acc
        
-- *Sets> difference [1..10] [5..10]
-- [1,2,3,4]
-- *Sets> difference [1..10] [1..10]
-- []
-- *Sets> difference [1..10] []
-- [1,2,3,4,5,6,7,8,9,10]
  
grandUnion :: Eq a => [Set a] -> Set a
grandUnion = foldr union []

grandIntersection :: Eq a => [Set a] -> Set a
grandIntersection = foldr1 intersection

-- just saying foldr intersection []  is a bug because 
-- you try to intersect with the empty list resulting in an empty list

grandIntersection' :: Eq a => [Set a] -> Set a
grandIntersection' [] = []
grandIntersection' (x:xs) = foldr intersection x xs

-- but this is just grandIntersection with a clause for the empty:

grandIntersection'' :: Eq a => [Set a] -> Set a
grandIntersection'' [] = []
grandIntersection'' xs = foldr1 intersection xs

--------------------------------------------------------------------------------
-- Exercise 1

setA, setB :: Set Integer
setA = [1..5]
setB = [2,4,6]

-- A U (B ^ A) = [1..5] U ([2,4,6] ^ [1..5]) = [1..5] U [2,4] = [1..5] = A
ex1a = setA `union` (setB `intersection` setA)
-- ex1a: [1,2,3,4,5]

-- (A ^ B) U B = ([1..5] ^ [2,4,6]) U [2,4,6] = [2,4] U [2,4,6] = [2,4,6]
ex1b = (setA `intersection` setB) `union` setB
-- ex1b: [6,2,4]

-- A - B = [1..5] - [2,4,6] = [1,3,5]
ex1c = setA `difference` setB
-- ex1c: [1,3,5]

-- (B - A) ^ B = ([2,4,6] - [1..5]) ^ [2,4,6] = [6] ^ [2,4,6] = [6]
ex1d = (setB `difference` setA) `intersection` setB
-- ex1d: [6]

-- A U (B - A) = [1..5] U ([2,4,6] - [1..5]) = [1..5] U [6] = [1..6]
ex1e = setA `union` (setB `difference` setA)
-- ex1e : [6,1,2,3,4,5]

--------------------------------------------------------------------------------
-- Complement and Power

complement :: Eq a => Set a -> Set a -> Set a
complement universe = (universe `difference`)

powerset :: Eq a => Set a -> [Set a]
powerset [] = [[]]
powerset (x:xs) = xss ++ map (x:) xss
  where xss = powerset xs
-- from: http://www.haskell.org/pipermail/haskell-cafe/2003-June/004484.html        
-- this is inefficient, as discussed in the link        
        
-- =============================================================================
-- 8.3 Finite Sets with Equality

{- We're working exclusively with finite sets because our implementations of set
   operations rely on the sets being finite.

   e.g. in union, we're checking that the element from y is not in x
        if x is infinite, this check won't terminate because we haven't 
        made any assumptions about x and y, so we have to check the entire set.


   Equality: is also a strong requirement, because we can't store items like 
   functions inside sets. 

-}

--------------------------------------------------------------------------------
-- Exercise 2
-- Compute the values of the expressions

ex2a = [1,2,3] `union` [3]  -- [1,2,3]

ex2b = [4,2] `union` [2,4] -- [4,2]

ex2c = [1,2,3] `intersection` [3] -- [3]

ex2d = [] `intersection` [1,3,5] -- []

ex2e = [1,2,3] `difference` [3] -- [1,2]

ex2f = [2,3] `difference` [1,2,3] -- []

ex2g = [1,2,3] `intersection` [1,2] -- [1,2]

ex2h = [1,2,3] `union` [4,5,6] -- [4,5,6,1,2,3]

ex2i = ([4,3] `difference` [5,4]) `intersection` [1,2] -- [3] `intersection` [1,2] = []

ex2j = ([3,2,4] `union` [4,2]) `difference` [2,3]  -- [3,2,4] `difference` [2,3] = [4]

ex2k = isSubset [3,4] [4,5,6] -- False (3 is not in [4,5,6])

ex2l = isSubset [1,3] [4,1,3,6] -- True

ex2m = isSubset [] [1,2,3] -- True (empty set is subset of every set)

ex2n = [1,2] `equalSets` [2,1] -- True

ex2o = [3,4,6] `equalSets` [2,3,5] -- False: 4,6 not in second set; 2,5 not in first set

ex2p = [1,2,3] `difference` [1] -- [2,3]

ex2q = [] `difference` [1,2] -- []

--------------------------------------------------------------------------------
-- Exercise 3: Powersets

ex3a = powerset [3,2,4]

{- Answer: [[], [2], [3], [4], [2,3], [2,4], [3,4], [2,3,4]]

> ex3a
[[],[4],[2],[2,4],[3],[3,4],[3,2],[3,2,4]]
-}

ex3b = powerset [2]

{- answer: [[], [2]]
> ex3b
[[],[2]]
-}

--------------------------------------------------------------------------------
-- Exercise 4: Cross Product

crossProduct :: Set a -> Set b -> Set (a,b)
crossProduct xs ys= [(x,y) | x <- xs, y <- ys]

ex4a = crossProduct [1,2,3] "ab"
{- Answer: [(1,a), (1,b), (2,a), (2,b), (3,a), (3,b)]

> ex4a
[(1,'a'),(1,'b'),(2,'a'),(2,'b'),(3,'a'),(3,'b')]
-}

ex4b = crossProduct [1] "ab"
{- Answer: [(1,a), (1,b)]

> ex4b
[(1,'a'),(1,'b')]
-}
   
--------------------------------------------------------------------------------
-- Exercise 5: Compute

set5u = [1..10] -- universe
set5a = [2..4]
set5b = [5..7]
set5c = [1,2]

ex5a = set5a `union` set5b -- [2,3,4,5,6,7]

ex5b = (set5u `difference` set5a) `intersection` (set5b `union` set5c)
-- [1,5,6,7,8,9,10] `intersect` ([5,6,7] U [1,2])
-- [1,5,6,7]

ex5c = set5c `difference` set5b
-- [1,2]

ex5d = (set5a `union` set5b) `union` set5c
-- [1,2,3,4,5,6,7]

ex5e = set5u `difference` set5a
-- [1,5,6,7,8,9,10]

ex5f = set5u `difference` (set5b `intersection` set5c)
-- Universe - (NULL) = Universe

{- *Sets> ex5a
[5,6,7,2,3,4]
*Sets> ex5b
[1,5,6,7]
*Sets> ex5c
[1,2]
*Sets> ex5d
[1,5,6,7,2,3,4]
*Sets> ex5e
[1,5,6,7,8,9,10]
*Sets> ex5f
-}

--------------------------------------------------------------------------------
-- Exercise 6

ex6 = [x + y | x <- [1,2,3], y <- [4,5]]
-- [(+ 1 4), (+ 1 5), (+ 2 4), (+ 2 5), (+ 3 4), (+ 3 5)]
-- = [5,6,6,7,7,8]

-- *Sets> ex6
-- [5,6,6,7,7,8]

--------------------------------------------------------------------------------
-- Exercise 7
-- express as list comprehension: {x | x \in {1,2,3,4,5}, x < 0}

ex7 = [x | x <- [1..5], x < 0] -- []

--------------------------------------------------------------------------------
-- Exercise 8
-- express as list comprehension: {x + y | x \in {1,2,3}, y \in {4,5}}

ex8 = [x + y | x <- [1..3], y <- [4..5]] -- output is [5,6,6,7,9] (from ex 6)

--------------------------------------------------------------------------------
-- Exercise 9
-- express as a list comprehension: {x | x \in {1,2,.., 10}, even x}

ex9 = [x | x <- [1..10], even x] -- [2,4,6,8,10]

--------------------------------------------------------------------------------
-- Exercise 10
-- Value of:

ex10a = [1,3,4] `isSubset` [4,3] -- False because of '1'

ex10b = [] `isSubset` [2,3,4] -- True (null set is the subset of everything)

ex10c = [2,3] `equalSets` [4,5,6] -- False. intersection is null!

ex10d = [1,2] `equalSets` [1,2,3] -- False. 3 is not in first set.

{- *Sets> ex10a
False
*Sets> ex10b
True
*Sets> ex10c
False
*Sets> ex10d
False
-}

-- ================================================================================
-- 8.4 Set Laws

{- Theorem: Suppose A, B, C are sets. If A subset B and B subset C, then A subset C

Proof: direct proof starting from the left side
Suppose x is an arbitrary element of A
Then, A subset B means x is an element of B
But B is a subset of C, so x is an element of C

Since x was an arbitrary element, by introducing forall, we have
forall x in A, x in C which means that A is a subset of C
-}

{- Exercise 11: Prove that if A is a proper subset of B and B is a proper subset of C
   then A is a proper subset of C
By previous theorem, we know that A is a subset of C.

Since B is a proper subset of C, there is an element in C that is not in B
Call that element x.
x can't be in A either because every element of A is in B.

So x is in C but not in A, so A is a proper subset of C.

-}

{- Exercise 12: Prove if true, provide counterexample if false

12a: If A subset of B and B subset of C, A proper subset of C
FALSE: Suppose A, B, C are the same set.

12b: If A propersubset B, B propersubset C, A subset C
TRUE. 
Proof: A subset C simply means that forall x in A, x in C. 
So we can prove this directly:

Suppose x is an arbitrary element in A
then x is in B since A is a propersubset of B
then x is in C since B is a propersubset of C

So, forall x in A, x in C (by introducing forall)
So, x subset of C

-}

--------------------------------------------------------------------------------
-- Associativity and Commutative Operations

{- Theorem:
Commutativity
1. A U B = B U A
2. A ^ B = B ^ A

Associativity
3. A U (B U C) = (A U B) U C
4. A ^ (B ^ C) = (A ^ B) ^ C

5. A - B = A ^ B'

These proofs follow from the commutativity and associativity of the logical
operators AND and OR
-}

--------------------------------------------------------------------------------
-- Distributive Laws

{- Theorem: A ^ (B U C) = (A ^ B) U (A ^ C)
Proof: Direct proof starting from the left.

Suppose x is in A ^ (B U C)
Then, x in A and x in (B U C)        
i.e., x in A and (x in B or x in C)
by distributing the and over the ors,
(x in (A and B)) or (x in (A and C))
i.e. x is in ((A ^ B) U (A ^ C))
-}

-- Demorgan: (A U B)' = A' ^ B'
--           (A ^ B)' = A' U B'


-- =============================================================================
-- Further Reading

-- Mathematics from the Birth of Numbers by Gullberg

-- Classic Set Theory by Goldrei: "Self study textbook"

-- =============================================================================
-- Review Exercises Begin Here

-- Exercise 13: Prove or find counterexamples

{- 13a : (A' U B)' ^ C' = A ^ (B U C)'
Direct Proof starting from the left
  (A' U B)' ^ C'
= (A'' ^ B') ^ C' by Demorgan's laws
= (A ^ B') ^ C'  (double complement is identity)
= A ^ (B' ^ C')  (associativity of ^)
= A ^ (B U C)'   (de morgan)


-- 13b : A - (B U C)' = A ^ (B U C)
Suppose x is in A - (B U C)'
i.e. x is in A and x not in (B U C)'
i.e. x is in A and x is in (B U C)
so x is in A ^ (B U C)

-- 13c : (A ^ B) U (A ^ B') = A
Proof of x in A => x in ((A ^ B) U (A ^ B'))
Consider an arbitrary element x in A
Either x is in B or x is not in B
So, x will be in either (A ^ B) or in (A ^ B')
So, x will be in (A ^ B) U (A ^ B')

Proof of x in ((A ^ B) U (A ^ B')) => x in A
We also need to show that an element that is not in A is not in (A ^ B) U (A ^ B')
Suppose y is not in A
then, y is not in (A ^ B) and y is not in (A ^ B')
So, y is not in (A ^ B) U (A ^ B')
So, Left side doesn't contain any extra elements than the right side.

-- 13d : A U (B - A) = A U B
Direct Proof starting from the left

  A U (B - A) 
= A U (B ^ A')
= (A U B) ^ (A U A')
= (A U B) ^ Universe
= (A U B)

-- 13e: A - B = B' - A'
Proof:
Left Side is
  A - B
= A ^ B'

Right Side is
  B' - A'
= B' ^ A''
= B' ^ A

-- 13f: A ^ (B - C) = (A ^ B) - (A ^ C)
LHS:
A ^ (B ^ C') = A ^ B ^ C'
RHS:
(A ^ B) ^ (A ^ C)'
= (A ^ B) ^ (A' U C') by Demorgan
= ((A ^ B) ^ A') U ((A ^ B) ^ C')
= NULL U (A ^ B ^ C')   (since A ^ A' is null)
= A ^ B ^ C'

-- 13g: A - (B U C) = (A - B) ^ (A - C)
LHS:
A ^ (B U C)'
= A ^ (B' ^ C')
RHS:
(A - B) ^ (A - C)
= (A ^ B') ^ (A ^ C')
= A ^ B' ^ A ^ C'
= A ^ B' ^ C' 

-- 13h: A ^ (A' U B) = A ^ B
LHS:
(A ^ A') U (A ^ B)
= NULL U (A ^ B)
= A ^ B

-- 13i: (A - B') U (A - C') = A ^ (B ^ C)
LHS: 
(A ^ B) U (A ^ C) 
= A ^ (B U C) 
which is not A ^ (B ^ C)
So any case where (B U C)  != B ^ C i.e. B != C works.
-}


--------------------------------------------------------------------------------
-- Exercise 14: Write smaller :: Ord a => a -> [a] -> Bool
-- True if value is smaller than the first element of the list

smaller :: Ord a => a -> [a] -> Bool
smaller _ [] = True
smaller x (y:_) = x < y

-- using this, write a function that takes a set and returns its powerset.

powerset2 :: (Eq a, Ord a) => [a] -> [[a]]
powerset2 = foldr conjoin [[]]
  where conjoin new acc = [new:x | x <- acc, new `smaller` x, not (new `elem` x)] ++ acc

--------------------------------------------------------------------------------
-- Exercise 15: Prove that (A U B)' = ((A U A') ^ A') ^ ((B U B') ^ B')

{- Direct Proof starting from the right

  ((A U A') ^ A') ^ ((B U B') ^ B')
= (Universe ^ A') ^ (Universe ^ B')  since X U X' = Universe
= A' ^ B'    since Universe ^ X = X
= (A U B)'   by Demorgan's Laws

-}

--------------------------------------------------------------------------------
-- Exercise 16: Write isSubset using list comprehension.
        
isSubsetLC xs ys = and [x `elem` ys | x <- xs]

-- *Sets> isSubsetLC [] []
-- True
-- *Sets> isSubsetLC [] [1,2,3]
-- True
-- *Sets> isSubsetLC [1,2,3] []
-- False
-- *Sets> isSubsetLC [1,2,3] [1..4]
-- True

--------------------------------------------------------------------------------
-- Exercise 17: What is wrong with the following definition of difference?

badDiff :: Eq a => [a] -> [a] -> [a]
badDiff set1 set2 = [e | e <- set2, not (elem e set1)]

-- This is computing set2 - set1 not set1 - set2

--------------------------------------------------------------------------------
-- Exercise 18: What is wrong with:

badIntersect set1 set2 = [e | e <- set1, e <- set2]

{- *Sets> badIntersect [1,2,3] [4,5,6]
[4,5,6,4,5,6,4,5,6]

What's happening?
From e <- set1, we set e to be 4
 But we draw elements from set2 and call them e as well
 So we shadow the previous binding and collect 4,5,6

This happens for each element of the first set

-}

--------------------------------------------------------------------------------
-- Ex 19: Write union using list comprehension


unionLC xs ys = [x | x <- xs, not (x `elem` ys)] ++ ys

--------------------------------------------------------------------------------
-- Ex 20: Can we ever have A U (B - C) = B?

{- Yes: Let A be the elements that were thrown out when we did B - C
   i.e. A = B ^ C 

   Then, A has the elements that were thrown out when we did B - C
         B - C has the other elements
   Combined, they give us B
-}

--------------------------------------------------------------------------------
-- Ex 21: Give an example where (A U C) ^ (B U C) = NULL

-- A,B,C are null

--------------------------------------------------------------------------------
-- Ex 22: Prove commutative law of set intersection: A ^ B = B ^ A

{- Direct Proof starting from Left
   Suppose x in A ^ B
   then x is in A and x is in B
   i.e. x is in B and x is in A (by commutativity of and)
   so x is in B ^ A
-}

--------------------------------------------------------------------------------
-- Ex 23: Express commutative law of set intersection in haskell

commutative a b = (a `intersection` b) `equalSets` (b `intersection` a)

--------------------------------------------------------------------------------
-- Ex 24: Prove associative law of set union A U (B U C) = (A U B) U C

{- Direct proof starting from the left
   Suppose x is in A U (B U C)
   Then, (x is in A) OR (x is in B U C)
   i.e. (x is in A) OR ((x is in B) or (x is in C))
   by associativity of OR
   ((x is in A) or (x is in B)) or (x is in C)
   i.e. x is in (A U B) U C

-}

--------------------------------------------------------------------------------
-- Ex 25: Prove that A - B = A ^ B'

{- Direct proof starting from the left   

   Suppose x in (A - B)
   Then, x is in A and x is not in B   (by definition of set difference)
   That is, x is in A and x is in B'   (by definition of complement)
   So, x is in (A ^ B')

-}

--------------------------------------------------------------------------------
-- Ex 26: Prove that A U (B ^ C) = (A U B) ^ (A U C)

{- Direct proof starting from the left
   
   Suppose x in A U (B ^ C)
   Then, (x is in A) or (x is in B ^ C)
   i.e., (x is in A) or ((x is in B) and (x is in C))
   By distributing or over the and, we get

   ((x is in A) or (x is in B)) and ((x is in A) or (x is in C))
   i.e. x in (A U B) ^ (A U C)
-}

--------------------------------------------------------------------------------
-- Ex 27: Prove De Morgan's laws for set intersection
--        (A ^ B)' = A' U B'

{- Direct proof starting from the left
   Suppose x is in (A ^ B)'
   The x is not in (A ^ B)
   
   Either x is not in A, or x is not in B (or both)
i.e. Either x is in A', or x is in B' (or both)
i.e. x is in (A' U B')

-}