{-# LANGUAGE NoImplicitPrelude, KindSignatures #-}
module Monads where
import Prelude hiding (filter)
import Data.Char (toUpper)
import Control.Monad (liftM, liftM2, guard)
data Tree a = Leaf a | Branch (Tree a) (Tree a)
deriving (Eq, Show)
-- | zip two trees together
zipTree :: Tree a -> Tree b -> Tree (a,b)
zipTree = undefined
testZip :: Bool
testZip =
zipTree (Branch (Leaf "a") (Branch (Leaf "b") (Leaf "c")))
(Branch (Leaf 0 ) (Branch (Leaf 1 ) (Leaf 2 )))
==
(Branch (Leaf ("a",0)) (Branch (Leaf ("b",1)) (Leaf ("c",2))))
t :: Tree String
t = Branch (Leaf "a")
(Branch (Leaf "b")
(Leaf "c"))
zipTree1 :: Tree a -> Tree b -> Maybe (Tree (a,b))
zipTree1 (Leaf a) (Leaf b) =
Just (Leaf (a,b))
zipTree1 (Branch l r) (Branch l' r') = undefined
zipTree1 _ _ = Nothing
zipTree2 :: Tree a -> Tree b -> Maybe (Tree (a,b))
zipTree2 (Leaf a) (Leaf b) = undefined
zipTree2 (Branch l r) (Branch l' r') = undefined
zipTree2 _ _ = Nothing
zipTree3 :: Tree a -> Tree b -> Maybe (Tree (a,b))
zipTree3 (Leaf a) (Leaf b) = do
return (Leaf (a,b))
zipTree3 (Branch l r) (Branch l' r') = do {
l'' <- zipTree3 l l' ; r'' <- zipTree3 r r' ; return (Branch l'' r'')
}
zipTree3 _ _ = Nothing
pairs :: [Int] -> [Int] -> [(Int,Int)]
pairs xs ys = concatMap (\x ->
concatMap (\y ->
[ (x,y) ] ) ys) xs
testPairs = pairs1 [1,2,3,4] [5,6,7,8]
pairs1 :: [Int] -> [Int] -> [(Int,Int)]
pairs1 xs ys = xs >>= \x ->
ys >>= \y ->
return (x,y)
pairs2 :: [Int] -> [Int] -> [(Int,Int)]
pairs2 xs ys = do
x <- xs
y <- ys
return (x,y)
testPairs2 = pairs1 [1,2,3,4] [5,6,7,8]
pairs3 xs ys = [ (x,y) | x <- xs, y <- ys ]
map' f xs = [ f x | x <- xs ]
-- map' f xs = [ y | x <- xs, y <- [f x] ] -- works
-- map' f xs = [ y | x <- xs, y <- [1..], y == [f x] ] -- doesn't work
pairs4 xs ys = [ (x,y) | x <- xs, x < 10, y <- ys, x < y ]
pairs4' xs ys = do x <- xs
y <- ys
if (x < y) then return (x,y) else []
pairs4'' xs ys = do x <- xs
y <- ys
guard (x < y)
return (x,y)
filter :: (a -> Bool) -> [a] -> [a]
filter f xs = [ x | x <- xs, f x ]
quicksort [] = []
quicksort (x:xs) = quicksort xs1 ++ [x] ++ quicksort xs2 where
xs1 = [ y | y <- xs , y < x ]
xs2 = [ y | y <- xs , y >= x ]