Solutions to exercises from Chapter 3 of "Discrete Mathematics Using a Computer"

DiscreteMathComputer03.hs

{- Discrete Mathematics Using a Computer
   Chapter 03 : Recursion
-}

-- ================================================================================
-- 3.1 Recursion over Lists
-- Ex 1: Write a function that copies its list argument. copy [2] -> [2]

copy :: [a] -> [a]
copy [] = []
copy (x:xs) = x:copy xs

--------------------------------------------------------------------------------
-- Ex 2: inverse: take a list of pairs and swap pair elements

inverse :: [(a,b)] -> [(b,a)]
inverse [] = []
inverse ((x,y):rest) = (y,x):inverse rest

--------------------------------------------------------------------------------
-- Ex 3: merge : combine two sorted lists

merge :: Ord a => [a] -> [a] -> [a]
merge [] ys = ys
merge xs [] = xs
merge a@(x:xs) b@(y:ys) = if x < y then x:(merge xs b) else y:(merge a ys)

--------------------------------------------------------------------------------
-- Ex 4: (!!) that returns a Maybe type

index :: [a] -> Int -> Maybe a
index [] n = Nothing
index (x:_) 0 = Just x
index (x:xs) n = index xs (n - 1)

-- index [1,2,3] 0 == Just 1
-- index [1,2,3] 2 == Just 3
-- index [1,2,3] 5 == Nothing

--------------------------------------------------------------------------------
-- Ex 5 : similar to assoc from common lisp

assoc :: Eq a => a -> [(a,b)] -> Maybe b
assoc x [] = Nothing
assoc x ((a,b):rest) = if x == a then Just b else assoc x rest

-- *Main> assoc 5 [(1,2),(5,3)]
-- Just 3
-- *Main> assoc 6 [(1,2),(5,3)]
-- Nothing

--------------------------------------------------------------------------------
-- Ex 6 Count the number of times an element occurs in a list

countOccurrences :: Eq a => a -> [a] -> Int
countOccurrences _ [] = 0
countOccurrences a (b:bs) = (if (a == b) then 1 else 0) + countOccurrences a bs

--------------------------------------------------------------------------------
-- Ex 7 Remove all occurrences of an item from a list

removeOccurrences :: Eq a => a -> [a] -> [a]
removeOccurrences _ [] = []
removeOccurrences x (y:ys)
  | x == y = removeOccurrences x ys
  | otherwise = x : removeOccurrences x ys

--------------------------------------------------------------------------------
-- Ex 8 Remove alternating elements of an item starting with the first one

keep :: [a] -> [a]
keep [] = []
keep (x:xs) = x : (throw xs)

throw :: [a] -> [a]
throw [] = []
throw (x:xs) = keep xs

removeAlternating :: [a] -> [a]
removeAlternating = throw

-- *Main> removeAlternating [1..7]
-- [2,4,6]

-- Alternate: using zip and list comprehensions
removeAlternating' xs = [a | (a,i) <- zip xs [1..], i `rem` 2 == 0]

--------------------------------------------------------------------------------
-- Ex 9 Extract the values from a list of Maybes

extract :: [Maybe a] -> [a]
extract [] = []
extract ((Just x):xs) = x : extract xs
extract (_:xs) = extract xs

-- Test:
-- *Main> extract [Just 3, Nothing, Just 7]
-- [3,7]

--------------------------------------------------------------------------------
-- Ex 10 substring
-- substr Haystack Needle

-- the book does it by using take and comparing equality:

substr :: String -> String -> Maybe Int
substr haystack needle = substr' haystack needle 0
  where substr' hay@(h:hs) need index = 
          if length need > length hay 
          then Nothing
          else if (take (length need) hay) == need 
               then Just index
               else substr' hs need (index + 1)
                    
-- TODO: use success and failure continuations to do this.
        

-- =============================================================================
-- 3.2 Higher Order Recursive Functions
-- HOF or combinators: general function that captures a computation pattern and
--                     takes in a functional argument to perform the specific
--                     computation desired

myMap :: (a -> b) -> [a] -> [b]
myMap f [] = []
myMap f (x:xs) = f x : myMap f xs

-- Recursion over two list arguments:
myZipWith :: (a -> b -> c) -> [a] -> [b] -> [c]
myZipWith f [] _ = []
myZipWith f _ [] = []
myZipWith f (x:xs) (y:ys) = f x y : myZipWith f xs ys

-- Foldr: captures the patter of "collapsing" a list into a single value
myFoldr :: (a -> b -> b) -> b -> [a] -> b
myFoldr _ z [] = z
myFoldr f z (x:xs) = f x (foldr f z xs)

-- now we can write:
sum' = foldr (+) 0
product' = foldr (*) 1
and' = foldr (&&) True
or' = foldr (||) False
factorial n = foldr (*) 1 [1..n]

-- TIP: Prefer higher over functions to recursive ones

--------------------------------------------------------------------------------
-- Ex 11 : foldrWith: collapse two arguments together

foldrWith :: (a -> b -> c -> c) -> c -> [a] -> [b] -> c
foldrWith _ z [] _ = z
foldrWith _ z _ [] = z
foldrWith f z (x:xs) (y:ys) = f x y (foldrWith f z xs ys)

-- example: dot product
dotProduct = foldrWith (\ x y acc -> x * y + acc) 0

--------------------------------------------------------------------------------
-- Ex 12: Write mappend with foldr such that mappend f xs = concat (map f xs)

mappend :: (a -> [b]) -> [a] -> [b]
mappend f = foldr (\elt acc -> f elt ++ acc) []

--------------------------------------------------------------------------------
-- Ex 13: removeDuplicates

removeDuplicates :: (Eq a) => [a] -> [a]
removeDuplicates = foldr adjoin []
  where adjoin x xs = if x `elem` xs then xs else x:xs

-- as it is written, it keeps the LAST occurrence of the element
-- e.g. removeDuplicates "abcdea" -> "bcdea"
-- to fix this, i could either reverse the input and reverse it back
-- or use foldl
        
removeDuplicates' :: (Eq a) => [a] -> [a]
removeDuplicates' = foldl adjoin []
  where adjoin xs x = if x `elem` xs then xs else x:xs

-- but this returns the actual string in the opposite order:
-- *Main> removeDuplicates' "abcdea"
-- "edcba"

-- fix: either do xs ++ [x] in adjoin or reverse the string in the end
        
removeDuplicates'' :: (Eq a) => [a] -> [a]
removeDuplicates'' = reverse . (foldl adjoin [])
  where adjoin xs x = if x `elem` xs then xs else x:xs

--------------------------------------------------------------------------------
-- Ex 14: elem

elemR :: (Eq a) => a -> [a] -> Bool
elemR _ [] = False
elemR a (x:xs)
  | a == x = True
  | otherwise = elemR a xs
                
elemF :: (Eq a) => a -> [a] -> Bool
elemF a = foldr search False
  where search elt acc
          | elt == a = True
          | otherwise = acc
                        
-- =============================================================================
-- 3.3 Peano Arithmetic
        
data Peano = Zero 
           | Succ Peano
           deriving (Show)
                    
decrement :: Peano -> Peano
decrement Zero = Zero
decrement (Succ x) = x

add :: Peano -> Peano -> Peano        
add m Zero = m
add m (Succ n) = add (Succ m) n

-- Subtraction: problem is that we don't have negative numbers, so we use zero
sub :: Peano -> Peano -> Peano
sub m Zero = m
sub Zero _ = Zero
sub (Succ m) (Succ n) = sub m n

instance Eq Peano where
  Zero == Zero = True
  (Succ m) == (Succ n)
   | m == n = True
   | otherwise = False
  _ == _ = False

-- =============================================================================
-- 3.4 Data Recursion

twos = 2 : twos

-- =============================================================================
-- 3.5 Suggestions for Further Reading

-- Textbooks on Haskell
-- SICP
-- Godel, Escher, Bach
-- "recursive function theory"

-- =============================================================================
-- 3.6 Review Exercises

-- Ex 15
intersection :: (Eq a) => [a] -> [a] -> [a]
intersection _ [] = []
intersection [] _ = []
intersection (x:xs) ys
  | x `elem` ys = x : intersection xs ys
  | otherwise = intersection xs ys

--------------------------------------------------------------------------------
-- Ex 16
-- is the first set a subset of the second?

isSubset :: (Eq a) => [a] -> [a] -> Bool
isSubset [] _ = True
isSubset _ [] = False
isSubset (x:xs) ys
  | x `elem` ys = isSubset xs ys
  | otherwise = False

--------------------------------------------------------------------------------
-- Ex 17
-- Recursive function that determines whether a list is sorted

isSorted :: (Ord a) => [a] -> Bool
isSorted [] = True
isSorted (x:xs) = (x `smallerThan` xs) && isSorted xs
  where x `smallerThan` [] = True
        x `smallerThan` (y:ys)
          | x <= y = x `smallerThan` ys
          | otherwise = False
                        
--------------------------------------------------------------------------------
-- Ex 18 
-- Show that factorial with foldr gives the same result as factorial with recursion
        
{-
Proof is by induction on n

Base case: n = 0
  Recursive Factorial gives 1 (by pattern matching)
  Foldr factorial gives: foldr (*) 1 [1..0]
                         = foldr (*) 1 []
                         = 1 (by definition of foldr)

Inductive case: n = k + 1
  Recursive function gives (k + 1) * factorial k (by pattern matching)
 
  Foldr factorial gives: foldr (*) 1 [1..k+1]
                         = (1 * (2 * ... (k + 1 * 1)))
                         = (k + 1) * (1 * (2 * ...(k * 1)) by commutativity of *
                         = (k + 1) * (foldr * 1 [1..k]) by defn of foldr
                         = (k + 1) * factorial k
QED
-}

--------------------------------------------------------------------------------
-- Ex 19
-- Using Recursion, define a function last that takes in a list and returns Maybe
-- that is Nothing if list is empty

last' :: [a] -> Maybe a
last' [] = Nothing
last' (x:xs) = combine (Just x) (last' xs)
  where combine (Just x) Nothing = Just x
        combine (Just x) (Just y) = Just y
        combine _ _ = Nothing
        
--------------------------------------------------------------------------------
-- Ex 20 
-- given a string with a number that has a decimal point, write two functions
-- one that returns the whole number part, another that returns the fract part

fracPart :: String -> String
fracPart [] = []
fracPart (x:xs)
  | x == '.' = xs
  | otherwise = fracPart xs
                
wholePart :: String -> String
wholePart [] = []
wholePart (x:xs)
  | x == '.' = []
  | otherwise = x : wholePart xs