Complete Chapter 12

Author: dwayne

ch12/BinaryTree.hs

@@ -0,0 +1,34 @@
+module BinaryTree where
+
+
+data BinaryTree a
+  = Leaf
+  | Node (BinaryTree a) a (BinaryTree a)
+  deriving (Eq, Ord, Show)
+
+
+-- 1
+unfold :: (a -> Maybe (a,b,a)) -> a -> BinaryTree b
+unfold f a =
+  case f a of
+    Nothing -> Leaf
+    Just (l, m, r) -> Node (unfold f l) m (unfold f r)
+
+
+-- 2
+-- >>> treeBuild 0
+-- Leaf
+-- >>> treeBuild 1
+-- Node Leaf 0 Leaf
+-- >>> treeBuild 2
+-- Node (Node Leaf 1 Leaf) 0 (Node Leaf 1 Leaf)
+-- >>> treeBuild 3
+-- Node (Node (Node Leaf 2 Leaf) 1 (Node Leaf 2 Leaf)) 0 (Node (Node Leaf 2 Leaf) 1 (Node Leaf 2 Leaf))
+treeBuild :: Integer -> BinaryTree Integer
+treeBuild n
+  | n < 0     = Leaf
+  | otherwise = unfold f 0
+    where
+      f k
+        | k == n    = Nothing
+        | otherwise = Just (k+1, k, k+1)

ch12/CountTheBeforeVowel.hs

@@ -0,0 +1,34 @@
+module CountTheBeforeVowel where
+
+
+countTheBeforeVowel :: String -> Integer
+countTheBeforeVowel s =
+  case words s of
+    []       -> 0
+    [w]      -> 0
+    theWords ->
+      let
+        classifiedWords = map classify theWords
+        count (IsThe, StartsWithVowel) accum = 1 + accum
+        count _ accum                        = accum
+      in
+        foldr count 0 $ zip classifiedWords (tail classifiedWords)
+
+
+data Classification = IsThe | StartsWithVowel | SomethingElse
+
+
+classify :: String -> Classification
+classify s
+  | s == "the"        = IsThe
+  | startsWithVowel s = StartsWithVowel
+  | otherwise         = SomethingElse
+
+
+startsWithVowel :: String -> Bool
+startsWithVowel []     = False
+startsWithVowel (c:cs) = isVowel c
+
+
+isVowel :: Char -> Bool
+isVowel c = c `elem` "aeiou"

ch12/CountVowels.hs

@@ -0,0 +1,14 @@
+module CountVowels where
+
+
+countVowels :: String -> Integer
+countVowels = len . filter isVowel
+
+
+len :: [a] -> Integer
+len [] = 0
+len (_:xs) = 1 + len xs
+
+
+isVowel :: Char -> Bool
+isVowel c = c `elem` "aeiou"

ch12/Either.hs

@@ -0,0 +1,61 @@
+module Either where
+
+
+-- 1
+-- >>> lefts' [Left 1, Left 2, Left 3]
+-- [1, 2, 3]
+-- >>> lefts' [Left 1, Right 2, Left 3]
+-- [1, 3]
+lefts' :: [Either a b] -> [a]
+lefts' = foldr left []
+  where
+    left (Left a) as  = a:as
+    left (Right _) as = as
+
+
+-- 2
+-- >>> rights' [Right 1, Right 2, Right 3]
+-- [1, 2, 3]
+-- >>> rights' [Right 1, Left 2, Right 3]
+-- [1, 3]
+rights' :: [Either a b] -> [b]
+rights' = foldr right []
+  where
+    right (Right b) bs = b:bs
+    right (Left _) bs  = bs
+
+
+-- 3
+-- >>> partitionEithers' [Left 1, Right 2, Left 3]
+-- ([1, 3], [2])
+partitionEithers' :: [Either a b] -> ([a], [b])
+partitionEithers' = foldr partition ([], [])
+  where
+    partition (Left a) (as, bs)  = (a:as, bs)
+    partition (Right b) (as, bs) = (as, b:bs)
+
+
+-- 4
+-- >>> eitherMaybe' (+1) (Left "hello")
+-- Nothing
+-- >>> eitherMaybe' (+1) (Right 1)
+-- Just 2
+eitherMaybe' :: (b -> c) -> Either a b -> Maybe c
+eitherMaybe' _ (Left _)  = Nothing
+eitherMaybe' f (Right b) = Just $ f b
+
+
+-- 5
+-- >>> either' (+1) (*5) (Left 2)
+-- 3
+-- >>> either' (+1) (*5) (Right 2)
+-- 10
+either' :: (a -> c) -> (b -> c) -> Either a b -> c
+either' f _ (Left a)  = f a
+either' _ g (Right b) = g b
+
+
+-- 6
+-- Same as eitherMaybe' but written in terms of either'
+eitherMaybe'' :: (b -> c) -> Either a b -> Maybe c
+eitherMaybe'' g = either' (const Nothing) (Just . g)

ch12/Maybe.hs

@@ -0,0 +1,83 @@
+module Maybe where
+
+
+-- 1
+-- >>> isJust (Just 1)
+-- True
+-- >>> isJust Nothing
+-- False
+isJust :: Maybe a -> Bool
+isJust Nothing = False
+isJust _       = True
+
+
+-- >>> isNothing (Just 1)
+-- False
+-- >>> isNothing Nothing
+-- True
+isNothing :: Maybe a -> Bool
+isNothing Nothing = True
+isNothing _       = False
+
+
+-- 2
+-- >>> mayybee 0 (+1) Nothing
+-- 0
+-- >>> mayybee 0 (+1) (Just 1)
+-- 2
+mayybee :: b -> (a -> b) -> Maybe a -> b
+mayybee b _ Nothing  = b
+mayybee _ f (Just a) = f a
+
+
+-- 3
+-- >>> fromMaybe 0 Nothing
+-- 0
+-- >>> fromMaybe 0 (Just 1)
+-- 1
+fromMaybe :: a -> Maybe a -> a
+fromMaybe a ma = mayybee a id ma
+
+
+-- 4
+-- >>> listToMaybe [1, 2, 3]
+-- Just 1
+-- >>> listToMaybe []
+-- Nothing
+listToMaybe :: [a] -> Maybe a
+listToMaybe []    = Nothing
+listToMaybe (x:_) = Just x
+
+
+-- >>> maybeToList (Just 1)
+-- [1]
+-- >>> maybeToList Nothing
+-- []
+maybeToList :: Maybe a -> [a]
+maybeToList Nothing  = []
+maybeToList (Just x) = [x]
+
+
+-- 5
+-- >>> catMaybes [Just 1, Nothing, Just 2]
+-- [1, 2]
+-- >>> catMaybes [Nothing, Nothing, Nothing]
+-- []
+catMaybes :: [Maybe a] -> [a]
+catMaybes []           = []
+catMaybes (Nothing:xs) = catMaybes xs
+catMaybes (Just x:xs)  = x : catMaybes xs
+
+
+-- 6
+-- >>> flipMaybe [Just 1, Just 2, Just 3]
+-- Just [1, 2, 3]
+-- >>> flipMaybe [Just 1, Nothing, Just 3]
+-- Nothing
+flipMaybe :: [Maybe a] -> Maybe [a]
+flipMaybe []          = Just []
+flipMaybe (Nothing:_) = Nothing
+flipMaybe (Just x:xs) =
+  case flipMaybe xs of
+    Just ys -> Just (x:ys)
+    Nothing -> Nothing

ch12/Natural.hs

@@ -1,14 +1,17 @@
 module Natural where
 
+
 data Nat
   = Zero
   | Succ Nat
   deriving (Eq, Show)
 
+
 natToInteger :: Nat -> Integer
 natToInteger Zero = 0
 natToInteger (Succ n) = 1 + natToInteger n
 
+
 integerToNat :: Integer -> Maybe Nat
 integerToNat k
   | k < 0 = Nothing

ch12/ReplaceThe.hs

@@ -0,0 +1,13 @@
+module ReplaceThe where
+
+import Data.List (intercalate)
+
+-- This may not be the solution they had in mind.
+
+
+replaceThe :: String -> String
+replaceThe s = intercalate " " $ map theToA (words s)
+  where
+    theToA :: String -> String
+    theToA "the"  = "a"
+    theToA s      = s

ch12/Unfolds.hs

@@ -0,0 +1,25 @@
+module Unfolds where
+
+
+-- 1
+-- >>> take 10 $ myIterate (+1) 0
+-- [0,1,2,3,4,5,6,7,9]
+myIterate :: (a -> a) -> a -> [a]
+myIterate f a = a : myIterate f (f a)
+
+
+-- 2
+-- >>> take 10 $ myUnfoldr (\b -> Just (b, b+1)) 0
+-- [0,1,2,3,4,5,6,7,8,9]
+myUnfoldr :: (b -> Maybe (a, b)) -> b -> [a]
+myUnfoldr f b =
+  case f b of
+    Nothing      -> []
+    Just (a, b') -> a : myUnfoldr f b'
+
+
+-- 3
+-- >>> take 10 $ betterIterate (+1) 0
+-- [0,1,2,3,4,5,6,7,8,9]
+betterIterate :: (a -> a) -> a -> [a]
+betterIterate f = myUnfoldr (\a -> Just (a, f a))

ch12/ValidateTheWord.hs

@@ -0,0 +1,20 @@
+module ValidateTheWord where
+
+
+newtype Word' = Word' String deriving (Eq, Show)
+
+
+vowels = "aeiou"
+
+
+mkWord :: String -> Maybe Word'
+mkWord s =
+  let
+    (nVowels, nConsonants) = foldr count (0, 0) s
+    count c (nv, nc)
+      | c `elem` vowels = (nv + 1, nc)
+      | otherwise       = (nv, nc + 1)
+  in
+    if nVowels > nConsonants
+    then Nothing
+    else Just (Word' s)

ch12/chex.txt

@@ -10,14 +10,32 @@ The kind of a is * and the kind of f is * -> *.
 
 String Processing
 
-To be completed...
+1. See ReplaceThe.hs.
+
+2. See CountTheBeforeVowel.hs.
+
+3. See CountVowels.hs.
 
 Validate the word
 
-To be completed...
+See ValidateTheWord.hs.
 
 It's only Natural
 
-See Natural.hs
+See Natural.hs.
+
+Small library for Maybe
+
+See Maybe.hs.
+
+Small library for Either
+
+See Either.hs.
+
+Unfolds
+
+See Unfolds.hs.
+
+Finally something other than a list!
 
-The rest has to be completed...
+See BinaryTree.hs.