Add remaining haskell book exercises

2 files changed, 221 insertions, 0 deletions

diff --git a/Haskell-book/12/Exercises.hs b/Haskell-book/12/Exercises.hs
new file mode 100644
index 0000000..73b81ba
--- /dev/null
+++ b/Haskell-book/12/Exercises.hs
@@ -0,0 +1,202 @@
+module Exercises where
+
+import Data.List
+
+--
+-- 1
+--
+notThe :: String -> Maybe String
+notThe x
+  | x == "the" = Nothing
+  | otherwise = Just x
+
+replaceThe :: String -> String
+replaceThe x = unwords $ map f (words x)
+    where f = f' . notThe
+          f' (Nothing) = "a"
+          f' (Just y)  = y
+
+isVowel :: Char -> Bool
+isVowel c
+  | c == 'a'  = True
+  | c == 'e'  = True
+  | c == 'i'  = True
+  | c == 'o'  = True
+  | c == 'u'  = True
+  | otherwise = False
+
+--
+-- 2
+--
+countTheBeforeVowel :: String -> Integer
+countTheBeforeVowel n = f False (words n)
+    where f _ []     = 0
+          f v (x:xs)
+            | x == "the" = f True xs
+            | v == True = (if isVowel (head x) then 1 else 0) + (f False xs)
+            | otherwise = f False xs
+
+--
+-- 3
+--
+countVowels :: String -> Integer
+countVowels s = fromIntegral $ length $ filter isVowel s
+
+--
+-- Validate the word
+--
+newtype Word' = Word' String deriving (Show, Eq)
+
+vowels :: String
+vowels = "aeiou"
+
+mkWord :: String -> Maybe Word'
+mkWord w = if (countVowels w) > (div (fromIntegral $ length w) 2)
+           then Nothing
+           else Just (Word' w)
+
+--
+-- It's only Natural
+--
+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 n
+  | n < 0     = Nothing
+  | n == 0    = Just Zero
+  | otherwise = Just (f n)
+      where f 0 = Zero
+            f n = Succ (f (n - 1))
+
+--
+-- Small library for Maybe
+--
+--
+-- 1
+--
+isJust :: Maybe a -> Bool
+isJust (Just _) = True
+isJust Nothing = False
+
+isNothing :: Maybe a -> Bool
+isNothing (Just _) = False
+isNothing Nothing = True
+
+--
+-- 2
+--
+mayybee :: b -> (a -> b) -> Maybe a -> b
+mayybee v f Nothing   = v
+mayybee v f (Just x) = f x
+
+--
+-- 3
+--
+fromMaybe :: a -> Maybe a -> a
+fromMaybe x Nothing  = x
+fromMaybe _ (Just x) = x
+
+--
+-- 4
+--
+listToMaybe :: [a] -> Maybe a
+listToMaybe [] = Nothing
+listToMaybe (x:xs) = Just x
+
+maybeToList :: Maybe a -> [a]
+maybeToList Nothing = []
+maybeToList (Just x) = [x]
+
+catMaybes :: [Maybe a] -> [a]
+catMaybes = foldr f []
+    where f Nothing xs = xs
+          f (Just x) xs = x : xs
+
+flipMaybe :: [Maybe a] -> Maybe [a]
+flipMaybe x = if (length x) == (length y) then (Just y) else Nothing
+    where y = catMaybes x
+
+lefts' :: [Either a b] -> [a]
+lefts' = foldr f []
+    where f (Left x) xs = x : xs
+          f _ xs = xs
+
+rights' :: [Either a b] -> [b]
+rights' = foldr f []
+    where f (Right x) xs = x : xs
+          f _ xs = xs
+
+partitionEithers' :: [Either a b] -> ([a], [b])
+partitionEithers' n = (lefts' n, rights' n)
+
+eitherMaybe' :: (b -> c) -> Either a b -> Maybe c
+eitherMaybe' _ (Left x) = Nothing
+eitherMaybe' f (Right x) = Just $ f x
+
+either' :: (a -> c) -> (b -> c) -> Either a b -> c
+either' f _ (Left x) = f x
+either' _ f (Right x) = f x
+
+eitherMaybe'' :: (b -> c) -> Either a b -> Maybe c
+eitherMaybe'' f = either' (\_ -> Nothing) (\x -> Just $ f x)
+
+--
+-- Unfolds
+--
+mehSum :: Num a => [a] -> a
+mehSum xs = go 0 xs
+    where go :: Num a => a -> [a] -> a
+          go n [] = n
+          go n (x:xs) = (go (n + x) xs)
+
+niceSum :: Num a => [a] -> a
+niceSum = foldl' (+) 0
+
+mehProduct :: Num a => [a] -> a
+mehProduct xs = go 1 xs
+    where go :: Num a => a -> [a] -> a
+          go n [] = n
+          go n (x:xs) = (go (n*x) xs)
+
+niceProduct :: Num a => [a] -> a
+niceProduct = foldl' (*) 1
+
+mehConcat :: [[a]] -> [a]
+mehConcat xs = go [] xs
+    where go :: [a] -> [[a]] -> [a]
+          go xs' [] = xs'
+          go xs' (x:xs) = (go (xs' ++ x) xs)
+
+niceConcat :: [[a]] -> [a]
+niceConcat = foldr (++) []
+
+myIterate :: (a -> a) -> a -> [a]
+myIterate f x = go x
+    where go x = x : (go (f x))
+
+myUnfoldr :: (b -> Maybe (a, b)) -> b -> [a]
+myUnfoldr f x = g (f x)
+    where g Nothing = []
+          g (Just (x, y)) = x : g (f y)
+
+betterIterate :: (a -> a) -> a -> [a]
+betterIterate f x = myUnfoldr (\y -> Just (y, f y)) x
+
+data BinaryTree a = Leaf
+                  | Node (BinaryTree a) a (BinaryTree a)
+                  deriving (Eq, Show)
+
+unfold :: (a -> Maybe (a, b, a)) -> a -> BinaryTree b
+unfold f x = g (f x)
+    where g Nothing = Leaf
+          g (Maybe (m, n, o)) = Node (BinaryTree m) n (BinaryTree o)
+
+treeBuild :: Integer -> BinaryTree Integer
+treeBuild = unfold f
+    where f n
+          | n <= 0 = Nothing
+          | otherwise = Just (k - 1, n, k - 1)
diff --git a/Haskell-book/12/Maybe.hs b/Haskell-book/12/Maybe.hs
new file mode 100644
index 0000000..e83176e
--- /dev/null
+++ b/Haskell-book/12/Maybe.hs
@@ -0,0 +1,19 @@
+module Maybe where
+
+--
+-- 1
+--
+isJust :: Maybe a -> Bool
+isJust (Just _) = True
+isJust Nothing = False
+
+isNothing :: Maybe a -> Bool
+isNothing (Just _) = False
+isNothing Nothing = True
+
+--
+-- 2
+--
+mayybee :: b -> (a -> b) -> Maybe a -> b
+mayybee v f Nothing   = b
+mayybee v f (Maybe x) = f x