book-exercises/Haskell-book/12/Exercises.hs

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)