Add remaining haskell book exercises
This commit is contained in:
202
Haskell-book/12/Exercises.hs
Normal file
202
Haskell-book/12/Exercises.hs
Normal file
@@ -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)
|
||||
Reference in New Issue
Block a user