├── exercises ├── picture.bmp ├── blueAndGreen.bmp ├── circle50cutRed.bmp ├── greenEverywhere.bmp ├── plus.ghoul ├── double.ghoul ├── multiply.ghoul ├── Ex2Test.hs ├── Ex4Test.hs └── Ex3Test.hs ├── .gitignore ├── tutorials ├── Tut02Live.hs ├── Tut05Live.hs ├── Tut02.md └── Tut08Live.hs ├── schedule.txt ├── lectures ├── Lec11Live.hs ├── Lec12Live.hs ├── Lec13Live.hs ├── Lec19.hs ├── Lec14Live.hs ├── Lec06Live.hs ├── Lec20.hs ├── Lec15Live.hs ├── Lec07.hs ├── Lec16.hs ├── Lec04.hs ├── Lec03-data │ └── birth.csv ├── Lec10.hs ├── Lec05.hs ├── Lec17.hs ├── Lec08.hs └── Lec01.hs └── README.md /exercises/picture.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bobatkey/CS316-18/HEAD/exercises/picture.bmp -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *~ 2 | *.o 3 | *.hi 4 | /lectures/Lec19 5 | /lectures/Lec19-sudoko 6 | /lectures/Lec20 7 | -------------------------------------------------------------------------------- /exercises/blueAndGreen.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bobatkey/CS316-18/HEAD/exercises/blueAndGreen.bmp -------------------------------------------------------------------------------- /exercises/circle50cutRed.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bobatkey/CS316-18/HEAD/exercises/circle50cutRed.bmp -------------------------------------------------------------------------------- /exercises/greenEverywhere.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bobatkey/CS316-18/HEAD/exercises/greenEverywhere.bmp -------------------------------------------------------------------------------- /exercises/plus.ghoul: -------------------------------------------------------------------------------- 1 | (plus Z y) -> y 2 | (plus (S x) y) -> (S (plus x y)) 3 | (main) -> (plus (S (S Z)) (S (S Z))) 4 | -------------------------------------------------------------------------------- /exercises/double.ghoul: -------------------------------------------------------------------------------- 1 | (plus Z y) -> y 2 | (plus (S x) y) -> (S (plus x y)) 3 | (double x) -> (plus x x) 4 | (main) -> (double (S (S (S Z)))) 5 | -------------------------------------------------------------------------------- /exercises/multiply.ghoul: -------------------------------------------------------------------------------- 1 | (plus Z y) -> y 2 | (plus (S x) y) -> (S (plus x y)) 3 | (mult Z y) -> Z 4 | (mult (S x) y) -> (plus (mult x y) y) 5 | (main) -> (mult (S (S (S Z))) (S (S (S Z)))) 6 | -------------------------------------------------------------------------------- /tutorials/Tut02Live.hs: -------------------------------------------------------------------------------- 1 | module Tut02 where 2 | 3 | second :: [a] -> a 4 | second xs = head (tail xs) 5 | 6 | head' :: [a] -> Maybe a 7 | head' [] = Nothing 8 | head' (x:xs) = Just x 9 | 10 | swap :: (a, a) -> (a, a) 11 | swap (x, y) = (y, x) 12 | 13 | pair :: a -> b -> (a, b) 14 | pair x y = (x, y) 15 | 16 | double :: Num a => a -> a 17 | double x = x * 2 18 | 19 | palindrome :: Eq c => [c] -> Bool 20 | palindrome xs = reverse xs == xs 21 | 22 | twice :: (e -> e) -> e -> e 23 | twice f x = f (f x) 24 | 25 | ---------------------------------------------------------------------- 26 | 27 | replicate' :: Int -> a -> [a] 28 | replicate' n x = [ x | _ <- [1..n] ] 29 | -- range(1,10) 30 | 31 | ---------------------------------------------------------------------- 32 | 33 | -- accumulators 34 | 35 | rev :: [a] -> [a] 36 | rev [] = [] 37 | rev (x:xs) = rev xs ++ [x] 38 | 39 | -- rev [3,2,1] 40 | -- = rev [2,1] ++ [3] 41 | -- = (rev [1] ++ [2]) ++ [3] 42 | -- = ((rev [] ++ [1]) ++ [2]) ++ [3] 43 | -- = (([] ++ [1]) ++ [2]) ++ [3] 44 | 45 | -- revAcc xs ys == rev xs ++ ys 46 | revAcc :: [a] -> [a] -> [a] 47 | revAcc [] ys = ys 48 | revAcc (x:xs) ys -- = rev (x:xs) ++ ys 49 | -- = (rev xs ++ [x]) ++ ys 50 | -- = rev xs ++ ([x] ++ ys) 51 | -- = rev xs ++ (x:ys) 52 | = revAcc xs (x:ys) 53 | 54 | -- revAcc [3,2,1] [] 55 | -- = revAcc [2,1] [3] 56 | -- = revAcc [1] [2,3] 57 | -- = revAcc [] [1,2,3] 58 | -- = [1,2,3] 59 | 60 | fac :: Integer -> Integer 61 | fac 0 = 1 62 | fac n = n * fac (n-1) 63 | 64 | fac' :: Integer -> Integer -> Integer 65 | fac' 0 acc = acc 66 | fac' n acc = fac' (n-1) $! (n * acc) 67 | 68 | -- fac' 4 1 69 | -- = fac' 3 (4 * 1) 70 | -- = fac' 2 (3 * (4 * 1)) 71 | -- = fac' 1 (2 * (3 * (4 * 1))) 72 | -- = fac' 0 (1 * (2 * (3 * (4 * 1)))) 73 | -- = (1 * (2 * (3 * (4 * 1)))) 74 | 75 | fac'' :: Integer -> Integer 76 | fac'' n = fac' n 1 77 | 78 | ignore :: a -> Int 79 | ignore x = 10 80 | -------------------------------------------------------------------------------- /tutorials/Tut05Live.hs: -------------------------------------------------------------------------------- 1 | module Tut05Live where 2 | 3 | -- 1. iterList 4 | 5 | mapList :: (a -> b) -> [a] -> [b] 6 | mapList f [] = [] 7 | mapList f (x:xs) = f x : mapList f xs 8 | 9 | mulList :: [Int] -> Int 10 | mulList [] = 1 11 | mulList (x:xs) = x * mulList xs 12 | 13 | iterList :: b -> (a -> b -> b) -> [a] -> b 14 | iterList z f [] = z 15 | iterList z f (x:xs) = f x (iterList z f xs) 16 | 17 | mapList' :: (a -> b) -> [a] -> [b] 18 | mapList' f = iterList [] (\x xs -> f x:xs) 19 | 20 | -- 2. Parser Combinators 21 | 22 | type Parser a = String -> Maybe (String,a) 23 | 24 | openCurly :: Parser () 25 | openCurly ('{':rest) = Just (rest, ()) 26 | openCurly _ = Nothing 27 | 28 | num :: Parser Int 29 | num ('0':rest) = Just (rest,0) 30 | num ('1':rest) = Just (rest,1) 31 | num ('2':rest) = Just (rest,2) 32 | num ('3':rest) = Just (rest,3) 33 | num ('4':rest) = Just (rest,4) 34 | num ('5':rest) = Just (rest,5) 35 | num ('6':rest) = Just (rest,6) 36 | num ('7':rest) = Just (rest,7) 37 | num ('8':rest) = Just (rest,8) 38 | num ('9':rest) = Just (rest,9) 39 | num _ = Nothing 40 | 41 | -- S ::= '{' | '0' | '1' | ... | '9' 42 | 43 | orElse :: Parser a -> Parser a -> Parser a 44 | orElse p1 p2 inp = 45 | case p1 inp of 46 | Nothing -> p2 inp 47 | Just a -> Just a 48 | 49 | mapParser :: (a -> b) -> Parser a -> Parser b 50 | mapParser f p inp = case p inp of 51 | Nothing -> Nothing 52 | Just (rest,a) -> Just (rest, f a) 53 | 54 | andThen :: Parser a -> Parser b -> Parser (a,b) 55 | andThen p1 p2 inp = 56 | case p1 inp of 57 | Nothing -> Nothing 58 | Just (rest,a) -> 59 | case p2 rest of 60 | Nothing -> Nothing 61 | Just (rest',b) -> Just (rest',(a,b)) 62 | 63 | eoi :: Parser () 64 | eoi "" = Just ("", ()) 65 | eoi _ = Nothing 66 | 67 | -- N ::= 'n' N | $ 68 | 69 | number :: Parser [Int] 70 | number = (mapParser (\(n,ns) -> n:ns) (num `andThen` number)) 71 | `orElse` 72 | (mapParser (\() -> []) eoi) 73 | 74 | properNumber :: Parser Int 75 | properNumber = mapParser listToProperNumber number 76 | 77 | listToProperNumber :: [Int] -> Int 78 | listToProperNumber = iterList 0 (\d n -> 10*n + d) . reverse 79 | 80 | -- YACC 81 | -- Yet Another Compiler Compiler 82 | 83 | 84 | -- number: 85 | -- | DIGIT number { make_list($1,$2) } 86 | -- | EOI { make_nil() } 87 | -------------------------------------------------------------------------------- /schedule.txt: -------------------------------------------------------------------------------- 1 | Wk Day Date Event Prac Purpose 2 | 1 Tue 18 Sep Lecture 1. programs made of equations; running them 3 | Fri 21 Sep Lecture 2. defining functions (H4) 4 | 2 Thu 27 Sep Deadline 1 4pm 5 | Thu 27 Sep Tutorial 2 T1. Prac2 unveil 6 | Fri 28 Sep Lecture 3. list comprehensions (H5) 7 | 3 Mon 1 Oct Lab 2 8 | Tue 2 Oct Lecture 4. recursive functions (H6) 9 | Thu 4 Oct Tutorial 2 T2. Prac2 firefight 10 | Fri 5 Oct Lecture 5. higher-order functions (H7) 11 | 4 Mon 8 Oct Lab 2 12 | Tue 9 Oct Lecture 6. declaring types and classes (H8) 13 | Thu 11 Oct Tutorial 3 T3. Prac3 unveil 14 | Fri 12 Oct Lecture 7. QuickCheck 15 | 5 Mon 15 Oct Deadline 2 2pm 16 | Lab-Test 2 17 | Tue 16 Oct Lecture 8. recursion schemes 18 | Thu 18 Oct Tutorial 2 T4. Prac2 autopsy 19 | Fri 19 Oct Lecture 9. functors and containers 20 | 6 Mon 22 Oct Lab 3 21 | Tue 23 Oct Lecture 10. building pure evaluators 22 | Thu 25 Oct Tutorial 3 T5. Prac3 firefight 23 | Fri 26 Oct Lecture 11. applicatives and monads (H12) 24 | 7 Mon 29 Oct Lab 3 25 | Tue 30 Oct Lecture 12. monads we like 26 | Thu 1 Nov Tutorial 4 T6. Prac4 unveil 27 | Fri 2 Nov Lecture 13. monadic parsing (H13) 28 | 8 Mon 5 Nov Deadline 3 2pm 29 | Lab-Test 3 Prac3 test 30 | Tue 6 Nov Lecture 14. more monadic parsing 31 | Thu 8 Nov Tutorial 3 T7. Prac3 autopsy 32 | Fri 9 Nov Lecture 15. state and custom monads 33 | 9 Mon 12 Nov Lab 4 34 | Tue 13 Nov Lecture 16. visiting and traversing containers 35 | Thu 15 Nov Tutorial 4 T8. Prac4 firefight 36 | Fri 16 Nov Lecture 17. infinite data and processes (H15) 37 | 10 Mon 19 Nov Lab 4 38 | Tue 20 Nov Lecture 18. Previ.se Guest Lecture 39 | Thu 22 Nov Tutorial 4 T9. Prac4 firefight 40 | Fri 23 Nov Lecture 19. parallelism 41 | 11 Mon 26 Nov Deadline 4 2pm 42 | Lab-Test 4 Prac4 test 43 | Tue 27 Nov Lecture 20. concurrency 44 | Thu 29 Nov Tutorial 4 T10. Prac4 autopsy 45 | Fri 30 Nov Lecture 21. a look at Agda (CS410 propaganda) 46 | -------------------------------------------------------------------------------- /lectures/Lec11Live.hs: -------------------------------------------------------------------------------- 1 | module Lec11Live where 2 | 3 | import Prelude hiding (Functor (..), Applicative (..), Monad (..)) 4 | 5 | {- LECTURE 11 : APPLICATIVES AND MONADS -} 6 | 7 | data Expr 8 | = Number Int 9 | | Add Expr Expr 10 | | Mul Expr Expr 11 | | If0ThenElse Expr Expr Expr 12 | | Throw 13 | | Catch Expr Expr 14 | | Print String Expr 15 | deriving Show 16 | 17 | evaluate :: Expr -> PrintAndThrow Int 18 | evaluate (Number i) = pure i 19 | evaluate (Add e1 e2) = pure (+) <*> evaluate e1 <*> evaluate e2 20 | evaluate (Mul e1 e2) = pure (*) <*> evaluate e1 <*> evaluate e2 21 | evaluate (If0ThenElse c t e) = 22 | evaluate c `sequ` \n -> 23 | if n == 0 then evaluate t else evaluate e 24 | {- 25 | pure (\n vt ve -> if n == 0 then vt else ve) 26 | <*> evaluate c 27 | <*> evaluate t 28 | <*> evaluate e 29 | -} 30 | evaluate Throw = P [] Nothing 31 | evaluate (Catch eTry eHandle) = 32 | case evaluate eTry of 33 | P outputs1 Nothing -> 34 | case evaluate eHandle of 35 | P outputs2 r -> P (outputs1 ++ outputs2) r 36 | r -> r 37 | evaluate (Print s e) = 38 | case evaluate e of 39 | P outputs r -> P (s:outputs) r 40 | 41 | sequ :: f a -> (a -> f b) -> f b 42 | sequ = undefined 43 | --(<*>) :: f a -> f (a -> b) -> f b 44 | 45 | prog = If0ThenElse (Number 0) 46 | (Print "then branch" (Number 1)) 47 | (Print "else branch" (Number 2)) 48 | 49 | myThrowingProgram :: Expr 50 | myThrowingProgram = 51 | (Number 1 `Add` Throw) `Catch` Number 4 52 | 53 | myThrowingProgram2 :: Expr 54 | myThrowingProgram2 = 55 | (Number 1 `Add` Print "about to throw" (Number 1)) 56 | `Catch` 57 | (Print "catch" (Number 4)) 58 | 59 | data PrintAndThrow a = P [String] (Maybe a) 60 | deriving Show 61 | 62 | instance Functor PrintAndThrow where 63 | fmap f (P outputs Nothing) = P outputs Nothing 64 | fmap f (P outputs (Just a)) = P outputs (Just (f a)) 65 | 66 | instance Applicative PrintAndThrow where 67 | pure x = P [] (Just x) 68 | 69 | P outputs1 Nothing <*> P outputs2 _ 70 | = P (outputs1++outputs2) Nothing 71 | P outputs1 _ <*> P outputs2 Nothing 72 | = P (outputs1++outputs2) Nothing 73 | P outputs1 (Just f) <*> P outputs2 (Just a) 74 | = P (outputs1 ++ outputs2) (Just (f a)) 75 | {- 76 | doOp :: ( a -> b -> c) -> 77 | PrintAndThrow a -> PrintAndThrow b -> PrintAndThrow c 78 | doOp f r1 r2 = 79 | case r1 of 80 | (outputs1, Nothing) -> (outputs1, Nothing) 81 | (outputs1, Just v1) -> 82 | case r2 of 83 | (outputs2, Nothing) -> (outputs1 ++ outputs2, Nothing) 84 | (outputs2, Just v2) -> (outputs1 ++ outputs2, Just (f v1 v2)) 85 | -} 86 | class Functor f where 87 | fmap :: (a -> b) -> f a -> f b 88 | 89 | class Functor f => Applicative f where 90 | pure :: a -> f a 91 | (<*>) :: f (a -> b) -> f a -> f b 92 | 93 | 94 | 95 | -- doOp :: (a -> b -> c) -> f a -> f b -> f c 96 | {- 97 | class Monoid m where 98 | mempty :: m 99 | mappend :: m -> m -> m 100 | -} 101 | --ap :: f (a -> b) -> f a -> f b 102 | --ap cF cA = doOp (\f a -> f a) cF cA 103 | -------------------------------------------------------------------------------- /lectures/Lec12Live.hs: -------------------------------------------------------------------------------- 1 | module Lec12Live where 2 | 3 | {- LECTURE 12 : MONADS -} 4 | 5 | {- 1. Recap some abstractions -} 6 | 7 | f :: Int -> IO Int 8 | f x = do print "running f (FIXME: remove this code before submitting)"; return (x+1) 9 | 10 | class MyFunctor f where 11 | myfmap :: (a -> b) -> f a -> f b 12 | 13 | class MyFunctor f => MyApplicative f where 14 | mypure :: a -> f a 15 | (<**>) :: f (a -> b) -> f a -> f b 16 | 17 | data Printing a = MkP [String] a 18 | deriving Show 19 | 20 | instance Functor Printing where 21 | fmap f (MkP outputs a) = MkP outputs (f a) 22 | 23 | instance Applicative Printing where 24 | -- pure :: a -> Printing a 25 | pure x = MkP [] x 26 | 27 | -- (<*>) :: Printing (a->b) -> Printing a -> Printing b 28 | MkP outputs1 f <*> MkP outputs2 a = 29 | MkP (outputs1 ++ outputs2) (f a) 30 | 31 | pr :: String -> Printing () 32 | pr s = MkP [s] () 33 | 34 | computation :: Int -> Printing Int 35 | computation x = pure (\() -> x+1) <*> pr "called 'computation'" 36 | {- 37 | pr "called 'computation'" :: Printing () 38 | (\() -> x+1) :: () -> Int 39 | pure (\() -> x+1) :: Printing (() -> Int) 40 | pure (\() -> x+1) <*> pr "called 'computation'" :: Printing Int 41 | -} 42 | 43 | -- sequ :: Process a -> (a -> Process b) -> Process b 44 | -- sequ = undefined 45 | {- 46 | class Applicative f => Monad f where 47 | return :: a -> f a 48 | (>>=) :: f a -> (a -> f b) -> f b 49 | -} 50 | instance Monad Printing where 51 | return = pure 52 | 53 | -- (>>=) :: Printing a -> (a -> Printing b) -> Printing b 54 | MkP outputs1 a >>= f = MkP (outputs1++outputs2) b 55 | where 56 | MkP outputs2 b = f a 57 | 58 | computation' :: Int -> Printing Int 59 | computation' x = 60 | do pr "called 'computation'" 61 | pr "printing again" 62 | return (x+1) 63 | 64 | -- do c1 ===> c1 >>= \() -> c2 65 | -- c2 66 | 67 | -- do x <- c1 ===> c1 >>= \x -> c2 68 | -- c2 69 | 70 | 71 | {- 2. The 'Maybe' monad -} 72 | 73 | {- data Maybe a = Nothing 74 | | Just a 75 | -} 76 | {- 77 | instance Monad Maybe where 78 | return x = Just x 79 | -- (>>=) :: Maybe a -> (a -> Maybe b) -> Maybe b 80 | Nothing >>= f = Nothing 81 | Just a >== f = f a 82 | -} 83 | 84 | abort :: Maybe a 85 | abort = Nothing 86 | 87 | computation3 :: Int -> Maybe Int 88 | computation3 x = 89 | if x > 5 then abort else return (x+1) 90 | 91 | data Tree a = Leaf | Node (Tree a) a (Tree a) deriving Show 92 | 93 | checkTree :: Tree Int -> Maybe () 94 | checkTree Leaf = return () 95 | checkTree (Node l a r) = 96 | if a < 0 then abort 97 | else do checkTree l 98 | checkTree r 99 | 100 | {- 3. The 'List' monad -} 101 | {- 102 | instance Monad [] where 103 | return x = [x] 104 | -- (>>=) :: [a] -> (a -> [b]) -> [b] 105 | as >>= f = concat (map f as) 106 | -} 107 | 108 | failure' :: [a] 109 | failure' = [] 110 | 111 | triples :: [(Int,Int,Int)] 112 | triples = do 113 | x <- [1..20] 114 | y <- [1..20] 115 | z <- [1..20] 116 | if x*x + y*y == z*z then 117 | return (x,y,z) 118 | else 119 | failure' 120 | 121 | {- 5. The 'IO' monad -} 122 | 123 | {- 124 | class Applicative f => Monad f where 125 | return :: a -> f a 126 | (>>=) :: f a -> (a -> f b) -> f b 127 | -} 128 | 129 | computation4 :: IO () 130 | computation4 = 131 | do putStrLn "Hello, what is your name?" 132 | name <- getLine 133 | putStrLn ("Hello " ++ name) 134 | -------------------------------------------------------------------------------- /lectures/Lec13Live.hs: -------------------------------------------------------------------------------- 1 | module Lec13Live where 2 | 3 | {- LECTURE 13 : PARSER COMBINATORS -} 4 | 5 | 6 | {- What is a parser? 7 | 8 | A parser of things is--- 9 | a function 10 | from strings 11 | to lists 12 | of pairs 13 | of strings 14 | and things! 15 | 16 | -- Fritz Ruehr (after Dr Suess) 17 | -} 18 | 19 | -- (1+2)+3 20 | 21 | -- time flies like an arrow 22 | -- fruit flies like a banana 23 | 24 | newtype Parser a = -- a parser of things 'a' 25 | MkParser (String -> -- a function from strings 26 | Maybe ( String -- pairs of strings 27 | , a)) -- and things 28 | 29 | runParser :: Parser a -> String -> Maybe (String, a) 30 | runParser (MkParser p) s = p s 31 | 32 | oldbob :: Parser () 33 | oldbob = MkParser recogniseBob 34 | where recogniseBob ('B':'o':'b':rest) = Just (rest, ()) 35 | recogniseBob _ = Nothing 36 | 37 | oldben :: Parser () 38 | oldben = MkParser recogniseBen 39 | where recogniseBen ('B':'e':'n':rest) = Just (rest, ()) 40 | recogniseBen _ = Nothing 41 | 42 | -- "(plus Z Z)" 43 | 44 | string :: String -> Parser () 45 | string expected = MkParser (p expected) 46 | where 47 | p :: String -> String -> Maybe (String, ()) 48 | p [] rest = Just (rest, ()) 49 | p (_:_) [] = Nothing 50 | p (e:es) (c:cs) | e == c = p es cs 51 | | otherwise = Nothing 52 | 53 | bob, ben, fred :: Parser () 54 | bob = string "Bob" 55 | ben = string "Ben" 56 | fred = string "Fred" 57 | 58 | orElse :: Parser a -> Parser a -> Parser a 59 | orElse (MkParser p1) (MkParser p2) = 60 | -- p1 :: String -> Maybe (String, a) 61 | -- p2 :: String -> Maybe (String, a) 62 | MkParser (\s -> case p1 s of 63 | Just result -> Just result 64 | Nothing -> p2 s) 65 | 66 | failure :: Parser a 67 | failure = MkParser (\s -> Nothing) 68 | 69 | data Person 70 | = Bob 71 | | Ben 72 | | Fred 73 | deriving Show 74 | 75 | alter :: (b -> a) -> Parser b -> Parser a 76 | alter f (MkParser p) = 77 | MkParser (\s -> case p s of 78 | Nothing -> Nothing 79 | Just (rest, y) -> Just (rest, f y)) 80 | 81 | instance Functor Parser where 82 | fmap f p = alter f p 83 | 84 | bob' = alter (\() -> Bob) bob 85 | ben' = alter (\() -> Ben) ben 86 | fred' = alter (\() -> Fred) fred 87 | 88 | personToString :: Person -> String 89 | personToString Bob = "Bob" 90 | personToString Ben = "Ben" 91 | personToString Fred = "Fred" 92 | 93 | andThen :: Parser a -> Parser b -> Parser (a,b) 94 | andThen (MkParser p1) (MkParser p2) = 95 | -- p1 :: String -> Maybe (String, a) 96 | -- p2 :: String -> Maybe (String, b) 97 | MkParser (\s -> case p1 s of 98 | Nothing -> Nothing 99 | Just (s0, a) -> 100 | case p2 s0 of 101 | Nothing -> Nothing 102 | Just (s1, b) -> Just (s1, (a,b))) 103 | 104 | person :: Parser Person 105 | person = bob' `orElse` ben' `orElse` fred' 106 | 107 | sequ parser = 108 | fmap (\((p,()),ps) -> p:ps) (parser `andThen` 109 | string "," `andThen` 110 | sequ parser) 111 | `orElse` 112 | fmap (\() -> []) (string "") 113 | {- 114 | fmap (\((((a,()),b),()),c) -> (a,b,c)) 115 | ( person 116 | `andThen` string "," 117 | `andThen` sequ 118 | `andThen` string "," 119 | `andThen` person) 120 | -} 121 | -------------------------------------------------------------------------------- /tutorials/Tut02.md: -------------------------------------------------------------------------------- 1 | ## Tutorial 2 Unassessed Homework 2 | 3 | 1. [H3.3] What are the types of the following functions? 4 | 5 | ```haskell 6 | second xs = head (tail xs) 7 | 8 | swap (x, y) = (y, x) 9 | 10 | pair x y = (x, y) 11 | 12 | double x = x * 2 13 | 14 | palindrome xs = reverse xs == xs 15 | 16 | twice f x = f (f x) 17 | ``` 18 | 19 | Hint: Take care to include the necessary class constraints in the 20 | types if the functions are defined using overloaded operators. 21 | 22 | 2. [H4.8] The Luhn algorithm is used to check bank card numbers for 23 | simple errors such as mistyping a digit, and proceeds as follows: 24 | 25 | * consider each digit as a separate number; 26 | * moving left, double every other number from the second last; 27 | * subtract 9 from each number that is now greater than 9; 28 | * add all the resulting numbers together; 29 | * if the total is divisible by 10, the card number is valid. 30 | 31 | 1. Define a function `luhnDouble :: Int -> Int` that doubles a digit 32 | and subtracts 9 if the result is greater than 9. For example 33 | 34 | > luhnDouble 3 35 | 6 36 | 37 | > luhnDouble 6 38 | 3 39 | 40 | 2. Using `luhnDouble` and the integer remainder function `mod`, define a function `luhnFour :: Int -> Int -> Int -> Int -> Bool` that decides if a four-digit bank card number is valid: For example: 41 | 42 | > luhnFour 1 7 8 4 43 | True 44 | 45 | > luhnFour 4 7 8 3 46 | False 47 | 48 | 3. Using `luhnDouble` and `mod` again, define a more general version `luhn :: [Int] -> Bool` of `luhnFour` that accepts card numbers of any length. 49 | 50 | 3. [H5.4] In a similar way to the function length, show how the library function `replicate :: Int -> a -> [a]` that produces a list of identical elements can be defined using a list comprehension. For example: 51 | 52 | ```shell 53 | > replicate 3 True 54 | [True,True,True] 55 | ``` 56 | 57 | 4. Recursion with accumulators. 58 | 59 | 1. Consider the following straightforward definition of a function that reverses a list: 60 | 61 | ```haskell 62 | rev :: [a] -> [a] 63 | rev [] = [] 64 | rev (x : xs) = rev xs ++ [x] 65 | ``` 66 | 67 | Because of the use of `(++)`, this will have O(n^2) run-time complexity. Rewrite the function using an *accumulator* to improve its efficiency: define a function `revAcc :: [a] -> [a] -> [a]` such that `rev xs = revAcc xs []`. Hint: you shouldn't use `(++)`, but instead "accumulate" the "partial result" of the computation in the extra argument, and return that at the end. 68 | 69 | 2. Accumulator-style programming can also be used to turn recursive functions into so-called *tail-recursive* functions, that is, functions where all recursive calls are final calls (calls where no further computation needs to happen afterwards). For instance, the following (silly) function is tail-recursive: 70 | 71 | ```haskell 72 | foo :: Bool -> Int -> Bool 73 | foo True n = n 74 | foo False m = foo True (1+m) 75 | ``` 76 | 77 | while this (equally silly) one is not: 78 | 79 | ```haskell 80 | goo :: Bool -> Int -> Bool 81 | goo True n = n 82 | goo False m = 1 + goo True m 83 | ``` 84 | 85 | Why not? Because the recursive call `goo True m` is not final: after computing it, we still need to compute `1 + ` the value of it. It is easier for compilers to optimise tail-recursive functions, because there is no need to save the current environment to return to after the call. 86 | 87 | Use an accumulator to turn the naive function 88 | 89 | ```haskell 90 | fac :: Integer -> Integer 91 | fac 0 = 1 92 | fac n = n * fac (n - 1) 93 | ``` 94 | 95 | into a tail-recursive function, i.e. define `facAcc :: Integer -> Integer -> Integer` and `fac' n = facAcc n initial` for a suitably chosen `initial :: Integer`. (Laziness makes it harder to reason about efficiency. Without jumping through further hoops, you might not notice a difference in practice between `fac` and `fac'`.) 96 | -------------------------------------------------------------------------------- /lectures/Lec19.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import System.Environment 4 | import Control.Parallel.Strategies 5 | import Debug.Trace 6 | 7 | {- LECTURE 19 : Parallelism 8 | 9 | This lecture is about running Haskell programs in parallel on 10 | multiple cores. 11 | 12 | Parallel programming is used to make programs run faster by 13 | splitting up their work so that it can be executed on multiple 14 | computing devices. It is not to be confused with concurrency -- 15 | which is programming with overlapping processes that communicate 16 | with each other. 17 | 18 | The main source for this lecture is the book: 19 | 20 | "Parallel and Concurrent Programming in Haskell" 21 | by Simon Marlow 22 | http://chimera.labs.oreilly.com/books/1230000000929 23 | 24 | which is available to read online for free. -} 25 | 26 | {--------------------------------------------------------------------} 27 | {- Part 1. Controlling Evaluation Order 28 | 29 | Recall from Lecture 17 that Haskell uses "Lazy Evaluation". This 30 | means that (a) nothing is computed until it is needed; and (b) 31 | nothing is computed more than once. Sometimes laziness means that 32 | unevaluated computations can build up, wasting space. We saw the 33 | strict application function ($!) and the odd function 'seq' for 34 | controlling evaluation order. -} 35 | 36 | traceWhenDone :: (Show a, Show b) => String -> (a -> b) -> (a -> b) 37 | traceWhenDone name f a = 38 | trace (name ++ " " ++ show a ++ " = " ++ show result) result 39 | where result = f a 40 | 41 | tracedFib1, tracedFib2 :: Int -> Int 42 | tracedFib1 = traceWhenDone "fib1" fib 43 | tracedFib2 = traceWhenDone "fib2" fib 44 | 45 | {- The most basic mechanism for controlling evaluation order in 46 | Haskell exploits the graph structure created for laziness to mark 47 | parts of the computation that can be executed in parallel. 48 | 49 | The Eval monad is a monad for providing parallelism hints and 50 | control evaluation order. (It is built on two lower-level 51 | primitives 'par' and 'pseq', which we won't cover in this lecture.) 52 | 53 | The 'Eval' monad provides these basic operations: 54 | 55 | runEval :: Eval a -> a 56 | 57 | rpar :: a -> Eval a 58 | 59 | rseq :: a -> Eval a 60 | 61 | 'rpar' means "you could evaluate my argument in parallel" 62 | 63 | 'rseq' means "evaluate my argument and wait for it to get to WHNF" 64 | 65 | We can use these to describe different evaluation mechanisms: -} 66 | 67 | sched0,sched1,sched2,sched3,sched4,sched5 68 | :: (a -> b) -> (a -> c) -> a -> (b,c) 69 | 70 | sched0 f g x = (f x, g x) 71 | 72 | {- This doesn't run anything until the values in the pair are 73 | requested. They are evaluated on demand while the requester waits 74 | for the answers. -} 75 | 76 | 77 | sched1 f g x = 78 | runEval $ do a <- rseq (f x) 79 | b <- rseq (g x) 80 | return (a, b) 81 | 82 | {- This runs 'f x' until it gets to a constructor, then it runs 'g x' 83 | until it gets to a constructor, then it returns the pair of WHNF 84 | values generated. -} 85 | 86 | 87 | sched2 f g x = 88 | runEval $ do a <- rpar (f x) 89 | b <- rpar (g x) 90 | return (a, b) 91 | 92 | {- This forks off a thread to run 'f x' in parallel, forks off a thread 93 | to run 'g x' in parallel, and then returns pointers to the boxes 94 | waiting for these two jobs. -} 95 | 96 | 97 | sched3 f g x = 98 | runEval $ do a <- rpar (f x) 99 | b <- rseq (g x) 100 | return (a, b) 101 | 102 | {- This forks off a thread to run 'f x', runs 'g x' to get a 103 | constructor. -} 104 | 105 | 106 | sched4 f g x = 107 | runEval $ do a <- rpar (f x) 108 | b <- rseq (g x) 109 | rseq a 110 | return (a, b) 111 | 112 | {- This forks off a thread to run 'f x', runs 'g x' to completion, and 113 | then waits for 'a' (which is a pointer to 'f x') to finish. -} 114 | 115 | 116 | sched5 f g x = 117 | runEval $ do a <- rpar (f x) 118 | b <- rpar (g x) 119 | rseq a 120 | rseq b 121 | return (a, b) 122 | 123 | {- This forks threads to run 'f x' and 'g x', then waits for both to 124 | finish and returns the results. -} 125 | 126 | {--------------------------------------------------------------------} 127 | {- Part 2 : FIBONACCI ! 128 | 129 | Let's try to parallelise fibonacci. -} 130 | 131 | fib :: Int -> Int 132 | fib 0 = 1 133 | fib 1 = 1 134 | fib n = fib (n-1) + fib (n-2) 135 | 136 | pfib :: Int -> Int -> Int 137 | pfib d 0 = 1 138 | pfib d 1 = 1 139 | pfib 0 n = pfib 0 (n-1) + pfib 0 (n-2) 140 | pfib d n = runEval (do 141 | x1 <- rpar (pfib (d-1) (n-1)) 142 | x2 <- rseq (pfib (d-1) (n-2)) 143 | return (x1 + x2)) 144 | 145 | main = do 146 | n <- read . head <$> getArgs 147 | print (pfib 2 n) 148 | -------------------------------------------------------------------------------- /lectures/Lec14Live.hs: -------------------------------------------------------------------------------- 1 | module Lec14Live where 2 | 3 | import Data.Char 4 | import Control.Applicative 5 | import Control.Monad 6 | 7 | {- LECTURE 14 : MORE PARSER COMBINATORS -} 8 | 9 | newtype Parser a = -- a parser of things 'a' 10 | MkParser (String -> -- a function from strings to 11 | Maybe ( String -- the possibility of pairs of strings 12 | , a)) -- and things 13 | 14 | runParser :: Parser a -> String -> Maybe (String, a) 15 | runParser (MkParser p) s = p s 16 | 17 | -- "char" 18 | 19 | char :: Parser Char 20 | char = MkParser (\s -> case s of 21 | (c:rest) -> Just (rest, c) 22 | "" -> Nothing) 23 | 24 | -- "alter", and Functors 25 | 26 | alter :: (a -> b) -> Parser a -> Parser b 27 | alter f (MkParser p) = 28 | MkParser (\s -> case p s of 29 | Nothing -> Nothing 30 | Just (rest, a) -> Just (rest, f a)) 31 | 32 | digit :: Parser Int 33 | digit = alter digitToInt char 34 | 35 | instance Functor Parser where 36 | --fmap :: (a -> b) -> Parser a -> Parser b 37 | fmap = alter 38 | 39 | -- "andThen", and Applicatives 40 | 41 | -- runParser (andThen digit digit) "12" = Just ("", (1, 2)) 42 | -- runParser (andThen digit char) "12" = Just ("", (1, '2')) 43 | -- runParser (andThen digit char) "1" = Nothing 44 | 45 | andThen :: Parser a -> Parser b -> Parser (a,b) 46 | andThen (MkParser p1) (MkParser p2) = 47 | MkParser (\s -> case p1 s of 48 | Nothing -> 49 | Nothing 50 | Just (rest, a) -> 51 | case p2 rest of 52 | Nothing -> 53 | Nothing 54 | Just (rest', b) -> 55 | Just (rest', (a,b))) 56 | 57 | nothing :: a -> Parser a 58 | nothing a = MkParser (\s -> Just (s, a)) 59 | 60 | instance Applicative Parser where 61 | -- pure :: a -> Parser a 62 | pure = nothing 63 | -- (<*>) :: Parser (a -> b) -> Parser a -> Parser b 64 | pf <*> pa = fmap (\(f,a) -> f a) (pf `andThen` pa) 65 | 66 | -- fmap :: ((a -> b,a) -> b) -> Parser (a -> b,a) -> Parser b 67 | 68 | digitAnd3Char :: Parser (((Int, Char), Char), Char) 69 | digitAnd3Char = digit `andThen` char `andThen` char `andThen` char 70 | 71 | digitAnd3Char' :: Parser (Int, Char, Char, Char) 72 | digitAnd3Char' = 73 | pure (\d c1 c2 c3 -> (d,c1,c2,c3)) 74 | <*> digit <*> char <*> char <*> char 75 | 76 | -- postProcess(getMailFromServer(), 77 | -- launchNuclearMissiles(), 78 | -- learn.proper.Object.Programming.hierarchies()) 79 | 80 | -- "orElse", and Alternatives 81 | 82 | orElse :: Parser a -> Parser a -> Parser a 83 | orElse (MkParser p1) (MkParser p2) = 84 | MkParser (\s -> case p1 s of 85 | Nothing -> 86 | p2 s 87 | Just (rest,a) -> 88 | Just (rest,a)) 89 | 90 | failure :: Parser a 91 | failure = MkParser (\s -> Nothing) 92 | 93 | twoChar :: Parser (Char, Char) 94 | twoChar = pure (\c1 c2 -> (c1,c2)) <*> char <*> char 95 | 96 | oneChar :: Parser (Char, Char) 97 | oneChar = pure (\c -> (c, 'Q')) <*> char 98 | 99 | {- 100 | class Alternative f where 101 | empty :: f a 102 | (<|>) :: f a -> f a -> f a 103 | -} 104 | 105 | instance Alternative Parser where 106 | empty = failure 107 | (<|>) = orElse 108 | 109 | -- fmap :: (a -> b) -> Parser a -> Parser b 110 | -- (<*>) :: Parser (a -> b) -> Parser a -> Parser b 111 | -- (>>=) :: Parser a -> (a -> Parser b) -> Parser b 112 | 113 | -- (<|>) :: Parser a -> Parser a -> Parser a 114 | 115 | -- "sequ", and Monads 116 | 117 | expectAnA :: Parser () 118 | expectAnA = undefined -- fmap (\c -> if c == 'A' then () else failure) char 119 | 120 | -- Parser a -> (a -> Parser b) -> Parser b 121 | 122 | {- class Monad f where 123 | return :: a -> f a 124 | (>>=) :: f a -> (a -> f b) -> f b 125 | -} 126 | 127 | instance Monad Parser where 128 | return = pure 129 | (>>=) = sequ 130 | 131 | sequ :: Parser a -> (a -> Parser b) -> Parser b 132 | sequ (MkParser p1) f = 133 | MkParser (\s -> case p1 s of 134 | Nothing -> Nothing 135 | Just (rest, a) -> 136 | -- continue (f a) rest) 137 | case f a of 138 | MkParser p2 -> 139 | p2 rest) 140 | 141 | -- continue (MkParser p2) rest = p2 rest 142 | 143 | expectAnAB :: Parser () 144 | expectAnAB = do c <- char 145 | c' <- char 146 | if c == 'A' && c' == 'B' then pure () 147 | else failure 148 | 149 | 150 | 151 | 152 | {- 153 | char >>= (\c -> 154 | char >>= (\c' -> 155 | if c == 'A' && c' == 'B' then pure () else failure)) 156 | -} 157 | 158 | 159 | 160 | 161 | satisfies :: (Char -> Bool) -> Parser Char 162 | satisfies = undefined 163 | 164 | 165 | -- Higher level combinators: sepBy, etc. 166 | 167 | 168 | -------------------------------------------------------------------------------- /lectures/Lec06Live.hs: -------------------------------------------------------------------------------- 1 | module Lec06Live where 2 | 3 | import Data.Char 4 | import Prelude hiding (Maybe (..), String, Monoid (..)) 5 | 6 | {- LECTURE 06 : DECLARING TYPES AND CLASSES -} 7 | 8 | {- PART I : TYPE SYNONYMS -} 9 | 10 | -- Useful for documentation 11 | 12 | -- Useful to prevent repeating yourself 13 | 14 | -- 1. String 15 | 16 | -- typedef int my_int; 17 | 18 | type Metres = Int 19 | 20 | type DB = [(String,Int,Double)] 21 | 22 | type String = [Char] 23 | 24 | add :: Metres -> Metres -> Metres 25 | add x y = x + y 26 | 27 | -- 2. Positions 28 | 29 | type Position = (Int,Int) 30 | 31 | origin :: Position 32 | origin = (0,0) 33 | 34 | -- 3. Transformations 35 | 36 | type Transformation = Position -> Position 37 | 38 | goNorth :: Transformation 39 | goNorth (x,y) = (x,y+1) 40 | 41 | -- 4. Parameterised abbreviations 42 | 43 | type Pair a = (a,a) 44 | 45 | type Position' = Pair Int 46 | 47 | -- type List a = Maybe (a, List a) 48 | 49 | 50 | 51 | 52 | 53 | {- PART II : DATA TYPES -} 54 | 55 | -- 1. Enumerations 56 | 57 | data Direction 58 | = North 59 | | South 60 | | East 61 | | West 62 | deriving Show 63 | 64 | -- 2. Maybe (replacement for 'null') 65 | -- https://www.infoq.com/presentations/Null-References-The-Billion-Dollar-Mistake-Tony-Hoare 66 | 67 | data Maybe a 68 | = Nothing 69 | | Just a 70 | deriving Show 71 | 72 | hd :: [a] -> Maybe a 73 | hd [] = Nothing 74 | hd (x:xs) = Just x 75 | 76 | -- 3. "Make Illegal States Unrepresentable" 77 | 78 | {- 79 | public class Student { 80 | // never null! 81 | @Nonnull 82 | private Optional name; 83 | 84 | // at least one of these is non-null 85 | private String registrationNumber; 86 | 87 | private String dsUsername; 88 | 89 | // ... 90 | } 91 | 92 | (Optional) 93 | -} 94 | 95 | data Student = 96 | MkStudent { studentName :: String 97 | , details :: StudentDetails 98 | } 99 | deriving Show 100 | 101 | data StudentDetails 102 | = OnlyRegNumber String 103 | | OnlyUsername String 104 | | BothRegAndUsername String String 105 | deriving Show 106 | 107 | -- 4. Trees 108 | 109 | data List a 110 | = Nil 111 | | Cons a (List a) 112 | deriving Show 113 | 114 | data Tree a 115 | = Leaf 116 | | Node (Tree a) a (Tree a) 117 | deriving Show 118 | 119 | exampleTree :: Tree Int 120 | exampleTree = Node (Node Leaf 1 Leaf) 2 (Node Leaf 3 Leaf) 121 | 122 | -- 5. XML / JSON 123 | 124 | data XML 125 | = Elem { tagName :: String, attributes :: [(String,String)], children :: [XML] } 126 | | Text String 127 | 128 | data JSON 129 | = Null 130 | | Boolean Bool 131 | | String String 132 | | Number Double 133 | | Object [(String,JSON)] 134 | | Array [JSON] 135 | deriving (Show) 136 | 137 | insert :: (a -> a -> Ordering) -> a -> [a] -> [a] 138 | insert cmp x [] = [x] 139 | insert cmp x (y:ys) = case cmp x y of 140 | EQ -> x : y : ys 141 | LT -> x : y : ys 142 | GT -> y : insert cmp x ys 143 | 144 | sort :: (a -> a -> Ordering) -> [a] -> [a] 145 | sort cmp [] = [] 146 | sort cmp (x:xs) = insert cmp x (sort cmp xs) 147 | 148 | instance Eq JSON where 149 | Null == Null = True 150 | --(==) Null Null = True 151 | Boolean b1 == Boolean b2 = b1 == b2 152 | String s1 == String s2 = s1 == s2 153 | Number d1 == Number d2 = d1 == d2 154 | Object fields1 == Object fields2 = 155 | sort (\(nm1,_) (nm2,_) -> compare nm1 nm2) fields1 156 | == sort (\(nm1,_) (nm2,_) -> compare nm1 nm2) fields2 157 | Array jsons1 == Array jsons2 = jsons1 == jsons2 158 | _ == _ = False 159 | 160 | 161 | upperCase :: JSON -> JSON 162 | upperCase Null = Null 163 | upperCase (Boolean b) = Boolean b 164 | upperCase (String s) = String (map toUpper s) 165 | upperCase (Number d) = Number d 166 | upperCase (Object fields) = Object (map (\(nm,j) -> (nm, upperCase j)) fields) 167 | upperCase (Array jsons) = Array (map upperCase jsons) 168 | 169 | testJSON :: JSON 170 | testJSON = Object [ ("field1", Number 2.0) 171 | , ("field2", String "two point oh") 172 | ] 173 | 174 | testJSON' :: JSON 175 | testJSON' = Object [ ("field2", String "two point oh") 176 | , ("field1", Number 2.0) 177 | ] 178 | 179 | 180 | 181 | -- { 'field1': 2.0, 'field2': "TWO POINT OH" } 182 | 183 | {- PART III : TYPE CLASSES -} 184 | 185 | -- 1. Show 186 | 187 | 188 | 189 | -- 2. Eq 190 | 191 | -- 3. Monoid 192 | 193 | class Monoid a where 194 | mempty :: a 195 | mappend :: a -> a -> a 196 | 197 | instance Monoid Int where 198 | mempty = 0 199 | mappend = (+) 200 | 201 | instance Monoid [a] where 202 | mempty = [] 203 | mappend = (++) 204 | 205 | instance Monoid Bool where 206 | mempty = True 207 | mappend = (&&) 208 | 209 | (<>) :: Monoid a => a -> a -> a 210 | (<>) = mappend 211 | 212 | crush :: Monoid a => [a] -> a 213 | crush [] = mempty 214 | crush (x:xs) = x <> crush xs 215 | 216 | 217 | -------------------------------------------------------------------------------- /exercises/Ex2Test.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -fwarn-incomplete-patterns #-} 2 | module Ex2Test where 3 | 4 | import Prelude hiding (words, lines, unlines) 5 | import Ex2 6 | 7 | {----------------------------------------------------------------------} 8 | {- CS316 (2018/19) EXERCISE 2 : FIRST-ORDER PROGRAMMING -} 9 | {- -} 10 | {- * * * TEST QUESTIONS * * * -} 11 | {----------------------------------------------------------------------} 12 | 13 | -- Submit by committing to GitLab at or before 2pm on Monday 15th 14 | -- October. There will be a test on this exercise in the lab on that 15 | -- date. 16 | -- 17 | -- Your combined score from the submission and the test will be worth 18 | -- 30% of the overall marks for the class (so one mark, below is worth 19 | -- half a percent). 20 | -- 21 | -- This file contains the test questions. Answer the questions in this 22 | -- file, and make sure that both are committed to GitLab both by the 23 | -- end of the lab session. 24 | 25 | {----------------------------------------------------------------------} 26 | {- PART 1 : FUN(ctional) WITH LISTS -} 27 | {----------------------------------------------------------------------} 28 | 29 | {- 2.1.6 TEST: Lines, Unlines. 30 | 31 | Write a pair of functions 'lines' and 'unlines' that respectively 32 | separate a string into lines by splitting at newline ('\n') 33 | characters and join a list of lines into a string by inserting 34 | newlines. -} 35 | 36 | lines :: String -> [String] 37 | lines = undefined 38 | 39 | unlines :: [String] -> String 40 | unlines = undefined 41 | 42 | {- 1 MARK -} 43 | 44 | {----------------------------------------------------------------------} 45 | {- PART II : CURSORS -} 46 | {----------------------------------------------------------------------} 47 | 48 | {- 2.2.3 (TEST) Inserting Strings. 49 | 50 | Using your 'insert' function, write a function that inserts a whole 51 | string before the cursor, as if it had been typed there. -} 52 | 53 | inserts :: [a] -> Cursor a -> Cursor a 54 | inserts = undefined 55 | 56 | {- 2 MARKS -} 57 | 58 | {- 2.2.4 (TEST) Overwriting. 59 | 60 | Write another editing function that /replaces/ the element 61 | underneath the cursor with the given one. If the cursor is at the 62 | end of the line, it should at as if the new character replaces the 63 | 'virtual' character at the end of the line. -} 64 | 65 | overwrite :: a -> Cursor a -> Cursor a 66 | overwrite = undefined 67 | 68 | {- 2 MARKS -} 69 | 70 | {- 2.2.6 (TEST) Backspace. 71 | 72 | Write a function that edits the cursor in the same way as your 73 | backspace key does. That is, it removes the character to the left 74 | of the cursor. Remember to think carefully about the possible edge 75 | cases. You may want to experiment with the backspace key in your 76 | text editor. Be careful not to delete the rest of your answers! -} 77 | 78 | backspace :: Cursor a -> Cursor a 79 | backspace = undefined 80 | 81 | {- 3 MARKS -} 82 | 83 | {- 2.2.7 (TEST) moveEnd 84 | 85 | Using 'moveRight' and 'getPoint', implement a recursive function 86 | that moves the cursor to the end of the string. -} 87 | 88 | moveEnd :: Cursor a -> Cursor a 89 | moveEnd = undefined 90 | 91 | {- 2 MARKS -} 92 | 93 | {- 2.2.8 (TEST) moveRightUntil 94 | 95 | Using 'getPoint' and 'moveRight', implement a recursive function 96 | that moves the cursor right until it finds a character that matches 97 | the given one. -} 98 | 99 | moveRightUntil :: Eq a => a -> Cursor a -> Cursor a 100 | moveRightUntil = undefined 101 | 102 | {- 3 MARKS -} 103 | 104 | {----------------------------------------------------------------------} 105 | {- PART 3 : REPRESENTING PROCESSES -} 106 | {----------------------------------------------------------------------} 107 | 108 | {- 2.3.5 (TEST) Expectations. Write a function that given a list of bits, 109 | generates a process that reads that many bits from the input and 110 | outputs 'True' if all the bits match the input list, and 'False' 111 | otherwise. You should have: 112 | 113 | process (expects [True]) [True] == [True] 114 | process (expects [True, True]) [True,False] == [False] 115 | process (expects [True, True]) [True,True] == [True] 116 | process (expects []) [True,False] == [True] 117 | 118 | Remember to always read all the bits! 119 | -} 120 | 121 | expects :: [Bool] -> Process 122 | expects = undefined 123 | 124 | {- 3 MARKS -} 125 | 126 | {- 2.3.7 (TEST) Maximum inputs 127 | 128 | Write a function that performs a 'static analysis' of a process 129 | (i.e., determines some property of a process without running it on 130 | actual data. Your function should compute the maximum number of 131 | bits the process will input on *any* run. 132 | 133 | You may find the function 'max' useful: 'x `max` y' returns the 134 | maximum of 'x' and 'y'. -} 135 | 136 | maxInputs :: Process -> Int 137 | maxInputs = undefined 138 | 139 | {- 3 MARKS -} 140 | 141 | {----------------------------------------------------------------------} 142 | {- END OF TEST -} 143 | {----------------------------------------------------------------------} 144 | -------------------------------------------------------------------------------- /tutorials/Tut08Live.hs: -------------------------------------------------------------------------------- 1 | module Tut08Live where 2 | 3 | import Control.Applicative 4 | 5 | {----------------------------------------------------------------------} 6 | {- GENERATING COMBINATIONS -} 7 | {----------------------------------------------------------------------} 8 | 9 | type Coin = Int 10 | 11 | ukCoins :: [Coin] 12 | ukCoins = [50,20,10,5,2,1] 13 | 14 | usCoins :: [Coin] 15 | usCoins = [25,10,5,2,1] 16 | 17 | makeChange :: Int -> [Coin] -> [Coin] -> [[Coin]] 18 | makeChange 0 selection coins = [selection] 19 | makeChange amount selection [] = empty 20 | makeChange amount selection (c:coins) = 21 | if c > amount then 22 | makeChange amount selection coins 23 | else 24 | makeChange (amount - c) (c:selection) (c:coins) 25 | <|> 26 | makeChange amount selection coins 27 | 28 | -- while (amount > 0) { 29 | -- int c = getNextCoin(); 30 | -- if (c > amount) { 31 | -- discardCoin(); 32 | -- } else { 33 | -- 34 | -- } 35 | 36 | 37 | 38 | 39 | {----------------------------------------------------------------------} 40 | {- STATE MONAD -} 41 | {----------------------------------------------------------------------} 42 | 43 | newtype State s a = St (s -> (s,a)) 44 | 45 | -- instance Functor (c -> ) 46 | -- fmap :: (a -> b) -> (c -> a) -> (c -> b) 47 | 48 | -- instance Functor (c,) where 49 | -- fmap :: (a -> b) -> (c,a) -> (c,b) 50 | 51 | instance Functor (State s) where 52 | fmap f (St t) = St (fmap (fmap f) t) 53 | 54 | instance Applicative (State s) where 55 | pure x = St (\s -> (s,x)) 56 | St t1 <*> St t2 = St (\s -> case t1 s of 57 | (s',f) -> case t2 s' of 58 | (s'',a) -> (s'',f a)) 59 | 60 | instance Monad (State s) where 61 | return = pure 62 | -- (>>=) :: State s a -> (a -> State s b) -> State s b 63 | St t >>= f = St (\s -> case t s of 64 | (s',a) -> case f a of 65 | St t2 -> 66 | t2 s') 67 | 68 | get :: State s s 69 | get = St (\s -> (s,s)) 70 | 71 | put :: s -> State s () 72 | put new_state = St (\_ -> (new_state,())) 73 | 74 | runState :: State s a -> s -> a 75 | runState (St t) s = case t s of 76 | (_, a) -> a 77 | 78 | program :: State Int Int 79 | program = do put 5 80 | x <- get 81 | put (x+4) 82 | get 83 | 84 | 85 | 86 | newtype NDState s a = ND (s -> [(s,a)]) 87 | 88 | instance Functor (NDState s) where 89 | fmap f (ND t) = ND (fmap (fmap (fmap f)) t) 90 | 91 | instance Applicative (NDState s) where 92 | pure x = ND (\s -> [(s,x)]) 93 | ND t1 <*> ND t2 = ND (\s -> [ (s'',f a) | (s',f) <- t1 s, (s'',a) <- t2 s' ]) 94 | 95 | instance Monad (NDState s) where 96 | return = pure 97 | -- (>>=) :: NDState s a -> (a -> NDState s b) -> NDState s b 98 | ND t >>= f = ND (\s -> [ (s'',b) | (s',a) <- t s 99 | , let ND t2 = f a 100 | , (s'',b) <- t2 s']) 101 | 102 | instance Alternative (NDState s) where 103 | empty = ND (\_ -> []) 104 | ND t1 <|> ND t2 = ND (\s -> t1 s ++ t2 s) 105 | 106 | get' :: NDState s s 107 | get' = ND (\s -> [(s,s)]) 108 | 109 | put' :: s -> NDState s () 110 | put' new_state = ND (\_ -> [(new_state,())]) 111 | 112 | runNDState :: NDState s a -> s -> [a] 113 | runNDState (ND t) s = [ a | (_,a) <- t s ] 114 | 115 | 116 | program' :: NDState Int Int 117 | program' = do put' 5 118 | x <- get' 119 | (put' (x+4) <|> put' (x+3)) 120 | get' 121 | 122 | 123 | nextCoin :: NDState [Coin] Coin 124 | nextCoin = do coins <- get' 125 | case coins of 126 | [] -> empty 127 | (c:_) -> pure c 128 | 129 | discardCoin :: NDState [Coin] () 130 | discardCoin = do coins <- get' 131 | case coins of 132 | [] -> empty 133 | (_:coins') -> put' coins' 134 | 135 | guard True = pure () 136 | guard False = empty 137 | 138 | makeChange2 :: Int -> [Coin] -> NDState [Coin] [Coin] 139 | makeChange2 0 selection = pure selection 140 | makeChange2 amount selection = 141 | do c <- nextCoin 142 | if c > amount then 143 | do discardCoin 144 | makeChange2 amount selection 145 | else 146 | (do discardCoin 147 | makeChange2 amount selection) 148 | <|> 149 | (do makeChange2 (amount - c) (c:selection)) 150 | 151 | makeChange3 :: Int -> [Coin] -> NDState [Coin] [Coin] 152 | makeChange3 0 selection = pure selection 153 | makeChange3 amount selection = 154 | (do c <- nextCoin 155 | guard (c <= amount) 156 | makeChange3 (amount - c) (c:selection)) 157 | <|> 158 | (do discardCoin 159 | makeChange3 amount selection) 160 | 161 | 162 | 163 | 164 | 165 | 166 | 167 | 168 | 169 | 170 | 171 | 172 | 173 | 174 | 175 | 176 | {- 177 | makeChange :: Int -> [Coin] -> [Coin] -> [[Coin]] 178 | makeChange 0 coins selection = [selection] 179 | makeChange amount [] selection = [] 180 | makeChange amount (c:coins) selection 181 | | c > amount = makeChange amount coins selection 182 | | otherwise = 183 | makeChange amount coins selection 184 | ++ makeChange (amount - c) coins (c:selection) 185 | -} 186 | -------------------------------------------------------------------------------- /lectures/Lec20.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | {- LECTURE 20 : CONCURRENCY -} 4 | 5 | import Control.Concurrent 6 | import Control.Monad (forever, forM_) 7 | import Network 8 | import System.IO 9 | import Text.Printf 10 | 11 | 12 | 13 | -- forkIO :: IO () -> IO ThreadId 14 | 15 | muddle :: IO () 16 | muddle = do 17 | hSetBuffering stdout NoBuffering 18 | forkIO (forM_ [1..1000] (\_ -> putChar 'A')) 19 | forM_ [1..1000] (\_ -> putChar 'B') 20 | 21 | 22 | 23 | -- threadDelay :: Int -> IO () 24 | 25 | setReminder :: String -> IO () 26 | setReminder s = do 27 | let t = read s :: Int 28 | printf "Ok, I'll remind you in %d seconds\n" t 29 | threadDelay (10^6 * t) 30 | printf "REMINDER!!! %d seconds are up\a\a\a\n" t 31 | 32 | reminderMain :: IO () 33 | reminderMain = loop 34 | where 35 | loop = do 36 | s <- getLine 37 | if s == "end" then return () 38 | else do forkIO (setReminder s) 39 | loop 40 | 41 | 42 | 43 | {- PART II : MVARS -} 44 | 45 | {- interface 46 | 47 | newEmptyMVar :: IO (MVar a) 48 | newMVar :: a -> IO (MVar a) 49 | takeMVar :: MVar a -> IO a 50 | putMVar :: MVar a -> a -> IO () 51 | 52 | newIORef :: a -> IO (IORef a) 53 | getIORef :: IORef a -> IO a 54 | putIORef :: IORef a -> a -> IO () 55 | 56 | -} 57 | 58 | mvar1 = do 59 | m <- newEmptyMVar 60 | forkIO $ putMVar m 'x' 61 | r <- takeMVar m 62 | print r 63 | 64 | 65 | 66 | 67 | mvar2 = do 68 | m <- newEmptyMVar 69 | forkIO $ do putMVar m 'x' 70 | putMVar m 'y' 71 | r <- takeMVar m 72 | print r 73 | r <- takeMVar m 74 | print r 75 | 76 | 77 | 78 | -- Logger example 79 | 80 | {- 81 | data Logger 82 | 83 | initLogger :: IO Logger 84 | logMessage :: Logger -> String -> IO () 85 | logStop :: Logger -> IO () 86 | 87 | -} 88 | 89 | data Logger = Logger (MVar LogCommand) 90 | 91 | data LogCommand = Message String | Stop (MVar ()) 92 | 93 | initLogger :: IO Logger 94 | initLogger = do 95 | m <- newEmptyMVar 96 | let l = Logger m 97 | forkIO (logger l) 98 | return l 99 | 100 | logger :: Logger -> IO () 101 | logger (Logger m) = loop 102 | where 103 | loop = do 104 | threadDelay (10^6 * 1) 105 | cmd <- takeMVar m 106 | case cmd of 107 | Message msg -> do 108 | putStrLn ("LOG: " ++ msg) 109 | loop 110 | Stop s -> do 111 | putStrLn "Stopping logger" 112 | putMVar s () 113 | 114 | 115 | logStop :: Logger -> () -> IO () 116 | logStop (Logger m) () = do 117 | s <- newEmptyMVar 118 | putMVar m (Stop s) 119 | takeMVar s 120 | 121 | logMessage :: Logger -> String -> IO () 122 | logMessage (Logger m) s = putMVar m (Message s) 123 | 124 | loggerMain :: IO () 125 | loggerMain = do 126 | l <- initLogger 127 | l `logMessage` "hello" 128 | putStrLn "We didn't wait for the log message" 129 | l `logMessage` "bye" 130 | l `logStop` () 131 | putStrLn "End of program" 132 | 133 | 134 | 135 | 136 | 137 | 138 | 139 | 140 | 141 | 142 | 143 | 144 | 145 | 146 | 147 | 148 | 149 | ---------------------------------------------------------------------- 150 | -- A server 151 | 152 | data CountingMsg = Inc | GetCount (MVar Int) 153 | 154 | newtype Counter = MkCounter (MVar CountingMsg) 155 | 156 | makeCounter :: IO Counter 157 | makeCounter = do 158 | m <- newEmptyMVar 159 | forkIO (loop m (0 :: Int)) 160 | return (MkCounter m) 161 | where 162 | loop m c = do 163 | cmd <- takeMVar m 164 | case cmd of 165 | Inc -> do 166 | printf "New doubling served! %d doublings so far!\n" (c+1) 167 | loop m (c+1) 168 | GetCount r -> do 169 | putMVar r c 170 | loop m c 171 | 172 | msgCounter :: Counter -> CountingMsg -> IO () 173 | msgCounter (MkCounter m) msg = 174 | putMVar m msg 175 | 176 | ---------------------------------------------------------------------- 177 | -- A Key-Value server 178 | updateMap :: MVar [(String,Int)] -> String -> Int -> IO () 179 | updateMap m k v = do 180 | kvs <- takeMVar m 181 | putMVar m ((k,v):kvs) 182 | 183 | readMap :: MVar [(String,Int)] -> String -> IO (Maybe Int) 184 | readMap m k = do 185 | kvs <- takeMVar m 186 | putMVar m kvs 187 | return (lookup k kvs) 188 | 189 | ---------------------------------------------------------------------- 190 | 191 | talk :: Handle -> Counter -> IO () 192 | talk h c = 193 | do hSetBuffering h LineBuffering 194 | hSetNewlineMode h (NewlineMode { inputNL = CRLF, outputNL = CRLF }) 195 | loop 196 | where 197 | loop = 198 | do line <- hGetLine h 199 | case line of 200 | "end" -> 201 | hPutStrLn h "Bye!" 202 | "count" -> do 203 | r <- newEmptyMVar 204 | c `msgCounter` (GetCount r) 205 | c <- takeMVar r 206 | hPutStrLn h ("Count is " ++ show c) 207 | loop 208 | line -> do 209 | hPutStrLn h (show (2 * read line :: Integer)) 210 | c `msgCounter` Inc 211 | loop 212 | 213 | 214 | main = do 215 | c <- makeCounter 216 | sock <- listenOn (PortNumber 1234) 217 | printf "Listening...\n" 218 | forever $ do 219 | (handle, host, port) <- accept sock 220 | printf "Accepted connection (%s:%s)\n" host (show port) 221 | forkFinally (talk handle c) 222 | (\_ -> do printf "Connection closed (%s:%s)\n" host (show port) 223 | hClose handle) 224 | -------------------------------------------------------------------------------- /lectures/Lec15Live.hs: -------------------------------------------------------------------------------- 1 | module Lec15Live where 2 | 3 | import Control.Applicative 4 | import Data.Char 5 | 6 | {- LECTURE 15 : YET MORE PARSING -} 7 | 8 | newtype Parser a = -- a parser of things 'a' 9 | MkParser (String -> -- a function from strings to 10 | Maybe ( String -- the possibility of pairs of strings 11 | , a)) -- and things 12 | 13 | runParser :: Parser a -> String -> Maybe (String, a) 14 | runParser (MkParser p) s = p s 15 | 16 | {- The interface: 17 | 18 | - char :: Parser Char 19 | - fmap :: (a -> b) -> Parser a -> Parser b 20 | - pure :: a -> Parser a "parse nothing" 21 | - (<*>) :: Parser (a -> b) -> Parser a -> Parser b "sequence" 22 | - empty :: Parser a 23 | - (<|>) :: Parser a -> Parser a -> Parser a "try the first, then 2nd" 24 | - (>>=) :: Parser a -> (a -> Parser b) -> Parser b 25 | -} 26 | 27 | digit :: Parser Int 28 | digit = do c <- char 29 | if isDigit c then 30 | pure (digitToInt c) 31 | else 32 | empty 33 | -- char >>= \c -> if isDigit c then pure (digitToInt c) else empty 34 | 35 | isChar :: Char -> Parser () 36 | isChar c = do c' <- char 37 | if c == c' then pure () else empty 38 | 39 | expr :: Parser Expr 40 | expr = do d <- digit; pure (Digit d) 41 | <|> parens (do e1 <- expr 42 | isChar '+' 43 | e2 <- expr 44 | pure (Add e1 e2)) 45 | 46 | parens :: Parser a -> Parser a 47 | parens p = do isChar '(' 48 | x <- p 49 | isChar ')' 50 | pure x 51 | 52 | data JSON 53 | = Null 54 | | Bool Bool 55 | | Number Int 56 | | String String 57 | | Array [JSON] 58 | | Object [(String,JSON)] 59 | deriving Show 60 | 61 | isString :: String -> Parser () 62 | isString "" = pure () 63 | isString (x:xs) = do isChar x; isString xs 64 | 65 | pNull :: Parser JSON 66 | pNull = do isString "null" 67 | pure Null 68 | 69 | pBool :: Parser JSON 70 | pBool = do isString "true"; pure (Bool True) 71 | <|> do isString "false"; pure (Bool False) 72 | 73 | digits :: Parser [Int] 74 | digits = do d <- digit; ds <- digits; pure (d:ds) 75 | <|> do d <- digit; pure [d] 76 | 77 | ofDigits :: [Int] -> Int 78 | ofDigits xs = go 0 xs 79 | where go n [] = n 80 | go n (d:ds) = go (n*10+d) ds 81 | 82 | pNumber :: Parser JSON 83 | pNumber = do ds <- digits 84 | pure (Number (ofDigits ds)) 85 | 86 | stringChars :: Parser String 87 | stringChars = do c <- char 88 | case c of 89 | '\\' -> do c <- char 90 | cs <- stringChars 91 | pure (c:cs) 92 | '"' -> pure [] 93 | c -> do cs <- stringChars 94 | pure (c:cs) 95 | 96 | -- "syuyu\"fyufs" 97 | pString :: Parser JSON 98 | pString = do isChar '"' 99 | cs <- stringChars 100 | -- isChar '"' 101 | pure (String cs) 102 | 103 | -- [1,2] 104 | 105 | pArray :: Parser a -> Parser [a] 106 | pArray p = do isChar '[' 107 | xs <- sepBy (do isChar ','; whitespace) p 108 | isChar ']' 109 | pure xs 110 | 111 | pObject :: Parser a -> Parser [(String,a)] 112 | pObject p = do isChar '{' 113 | fields <- sepBy (isChar ',') (do String name <- pString 114 | isChar ':' 115 | obj <- p 116 | pure (name,obj)) 117 | isChar '}' 118 | pure fields 119 | 120 | pJSON :: Parser JSON 121 | pJSON = pNull 122 | <|> pBool 123 | <|> pNumber 124 | <|> pString 125 | <|> fmap (\xs -> Array xs) (pArray pJSON) 126 | <|> fmap (\xs -> Object xs) (pObject pJSON) 127 | 128 | whitespace :: Parser () 129 | whitespace = do c <- char; if c == ' ' then whitespace else failure 130 | <|> pure () 131 | 132 | sepBy :: Parser () -> Parser a -> Parser [a] 133 | sepBy sep p = do x <- p 134 | ((do sep; xs <- sepBy sep p; pure (x:xs)) <|> pure [x]) 135 | <|> pure [] 136 | 137 | 138 | {- 139 | do d1 <- digit 140 | isChar '+' 141 | d2 <- digit 142 | pure (d1, d2)-} 143 | 144 | {- 4+((1+2)+3) -} 145 | 146 | data Expr 147 | = Digit Int 148 | | Add Expr Expr 149 | deriving Show 150 | 151 | 152 | 153 | 154 | 155 | 156 | char :: Parser Char 157 | char = MkParser (\s -> case s of 158 | (c:rest) -> Just (rest, c) 159 | "" -> Nothing) 160 | 161 | -- "alter", and Functors 162 | 163 | alter :: (a -> b) -> Parser a -> Parser b 164 | alter f (MkParser p) = 165 | MkParser (\s -> case p s of 166 | Nothing -> Nothing 167 | Just (rest, a) -> Just (rest, f a)) 168 | 169 | instance Functor Parser where 170 | --fmap :: (a -> b) -> Parser a -> Parser b 171 | fmap = alter 172 | 173 | andThen :: Parser a -> Parser b -> Parser (a,b) 174 | andThen (MkParser p1) (MkParser p2) = 175 | MkParser (\s -> case p1 s of 176 | Nothing -> 177 | Nothing 178 | Just (rest, a) -> 179 | case p2 rest of 180 | Nothing -> 181 | Nothing 182 | Just (rest', b) -> 183 | Just (rest', (a,b))) 184 | 185 | nothing :: a -> Parser a 186 | nothing a = MkParser (\s -> Just (s, a)) 187 | 188 | instance Applicative Parser where 189 | -- pure :: a -> Parser a 190 | pure = nothing 191 | -- (<*>) :: Parser (a -> b) -> Parser a -> Parser b 192 | pf <*> pa = fmap (\(f,a) -> f a) (pf `andThen` pa) 193 | 194 | 195 | orElse :: Parser a -> Parser a -> Parser a 196 | orElse (MkParser p1) (MkParser p2) = 197 | MkParser (\s -> case p1 s of 198 | Nothing -> 199 | p2 s 200 | Just (rest,a) -> 201 | Just (rest,a)) 202 | 203 | failure :: Parser a 204 | failure = MkParser (\s -> Nothing) 205 | 206 | instance Alternative Parser where 207 | empty = failure 208 | (<|>) = orElse 209 | 210 | instance Monad Parser where 211 | return = pure 212 | (>>=) = sequ 213 | 214 | sequ :: Parser a -> (a -> Parser b) -> Parser b 215 | sequ (MkParser p1) f = 216 | MkParser (\s -> case p1 s of 217 | Nothing -> Nothing 218 | Just (rest, a) -> 219 | -- continue (f a) rest) 220 | case f a of 221 | MkParser p2 -> 222 | p2 rest) 223 | -------------------------------------------------------------------------------- /lectures/Lec07.hs: -------------------------------------------------------------------------------- 1 | module Lec07 where 2 | 3 | import Test.QuickCheck 4 | import Data.Foldable 5 | 6 | {- LECTURE 07 : QUICKCHECK -} 7 | 8 | 9 | -- 1. Individual testing 10 | 11 | list_append_test1 :: Bool 12 | list_append_test1 = [1,2,3] ++ [] == [1,2,3] 13 | 14 | list_append_test2 :: Bool 15 | list_append_test2 = [1,2,3,4] ++ [] == [1,2,3,4] 16 | 17 | list_append_tests :: [Bool] 18 | list_append_tests = [ list_append_test1 19 | , list_append_test2 20 | ] 21 | 22 | -- 2. Property based testing 23 | 24 | list_append_prop1 :: [Int] -> Bool 25 | list_append_prop1 xs = xs ++ [] == xs 26 | 27 | list_append_prop2 :: [Int] -> Bool 28 | list_append_prop2 xs = [] ++ xs == xs 29 | 30 | list_append_prop3 :: [Int] -> [Int] -> [Int] -> Bool 31 | list_append_prop3 xs ys zs = (xs ++ ys) ++ zs == xs ++ (ys ++ zs) 32 | 33 | -- Monoids 34 | 35 | monoid_prop1 :: (Eq m, Monoid m) => m -> Bool 36 | monoid_prop1 x = x `mappend` mempty == x 37 | 38 | monoid_prop2 :: (Eq m, Monoid m) => m -> Bool 39 | monoid_prop2 x = mempty `mappend` x == x 40 | 41 | monoid_prop3 :: (Eq m, Monoid m) => m -> m -> m -> Bool 42 | monoid_prop3 x y z = (x `mappend` y) `mappend` z == x `mappend` (y `mappend` z) 43 | {- 44 | data RGBA = MkRGBA { redChannel :: Double 45 | , greenChannel :: Double 46 | , blueChannel :: Double 47 | , alphaChannel :: Double 48 | } 49 | deriving (Show, Eq) 50 | 51 | instance Arbitrary RGBA where 52 | arbitrary = MkRGBA <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary 53 | 54 | instance Monoid RGBA where 55 | mempty = 56 | MkRGBA 0 0 0 0 57 | 58 | mappend (MkRGBA r1 g1 b1 0) (MkRGBA r2 g2 b2 0) = mempty 59 | mappend (MkRGBA r1 g1 b1 a1) (MkRGBA r2 g2 b2 a2) = MkRGBA r g b a 60 | where 61 | a = a1 + a2 - a1*a2 62 | r = (a1*r1 + (1-a1)*a2*r2) / a 63 | g = (a1*g1 + (1-a1)*a2*g2) / a 64 | b = (a1*b1 + (1-a1)*a2*b2) / a 65 | 66 | 67 | colour_prop1 = monoid_prop1 :: RGBA -> Bool 68 | -} 69 | 70 | data Trit = True3 | False3 | Unknown deriving (Eq, Show) 71 | 72 | tritAnd :: Trit -> Trit -> Trit 73 | tritAnd False3 _ = False3 74 | tritAnd _ False3 = False3 75 | tritAnd Unknown _ = Unknown 76 | tritAnd _ Unknown = Unknown 77 | tritAnd True3 True3 = True3 78 | 79 | instance Arbitrary Trit where 80 | arbitrary = oneof [ pure True3, pure False3, pure Unknown ] 81 | 82 | instance Monoid Trit where 83 | mempty = True3 84 | mappend = tritAnd 85 | 86 | 87 | -- 3. Reference implementation testing 88 | 89 | 90 | insert :: Ord a => a -> [a] -> [a] 91 | insert x [] = [x] 92 | insert x (y:ys) 93 | | x <= y = x : y : ys 94 | | otherwise = y : insert x ys 95 | 96 | isort :: Ord a => [a] -> [a] 97 | isort [] = [] 98 | isort (x:xs) = insert x (isort xs) 99 | 100 | isSorted :: Ord a => [a] -> Bool 101 | isSorted [] = True 102 | isSorted [x] = True 103 | isSorted (x:y:ys) = x <= y && isSorted (y:ys) 104 | 105 | insert_preserves_sortedness :: Double -> [Double] -> Bool 106 | insert_preserves_sortedness x xs = 107 | isSorted (insert x (makeSorted 0 xs)) 108 | 109 | makeSorted :: Double -> [Double] -> [Double] 110 | makeSorted i [] = [] 111 | makeSorted i (x:xs) = y : makeSorted y xs 112 | where y = i + abs x 113 | 114 | 115 | {- 116 | module Lec08 where 117 | 118 | import Test.QuickCheck 119 | 120 | {- LECTURE 08: QUICKCHECK -} 121 | 122 | {- PART I : WRITING INDIVIDUAL TEST CASES -} 123 | 124 | -- artisanal testing, one at a time 125 | 126 | append_test_1 :: Bool 127 | append_test_1 = 128 | [1,2,3] ++ [4,5,6] == [1,2,3,4,5,6] 129 | 130 | append_test_2 :: Bool 131 | append_test_2 = 132 | [4,5,6] ++ [1,2,3] == [4,5,6,1,2,3] 133 | 134 | append_test_3 :: Bool 135 | append_test_3 = 136 | [] ++ [1,2,3] == [1,2,3] 137 | 138 | append_test_4 :: Bool 139 | append_test_4 = 140 | [1,2,3] ++ [] == [1,2,3] 141 | 142 | append_tests :: Bool 143 | append_tests = 144 | and [ append_test_1 145 | , append_test_2 146 | , append_test_3 147 | , append_test_4 148 | ] 149 | 150 | insert :: Ord a => a -> [a] -> [a] 151 | insert x [] = [x] 152 | insert x (y:ys) 153 | | x <= y = x : y : ys 154 | | otherwise = y : insert x ys 155 | 156 | insert_test_1 :: Bool 157 | insert_test_1 = 158 | insert 3 [1,2,4,5] == [1,2,3,4,5] 159 | 160 | 161 | 162 | {- PART II : PROPERTY BASED TESTING WITH QUICKCHECK -} 163 | 164 | -- http://www.cs.tufts.edu/~nr/cs257/archive/john-hughes/quick.pdf 165 | 166 | -- Why not test with lots of examples, not just one? 167 | 168 | append_left_nil_prop :: [Int] -> Bool 169 | append_left_nil_prop xs = 170 | [] ++ xs == xs 171 | 172 | append_right_nil_prop :: [Int] -> Bool 173 | append_right_nil_prop xs = 174 | xs ++ [] == xs 175 | 176 | append_faulty_prop :: [Int] -> Bool 177 | append_faulty_prop xs = 178 | xs ++ [0] == xs 179 | 180 | -- (x + y) + z = x + (y + z) 181 | 182 | append_assoc :: [Int] -> [Int] -> [Int] -> Bool 183 | append_assoc xs ys zs = 184 | (xs ++ ys) ++ zs == xs ++ (ys ++ zs) 185 | 186 | reverse_reverse_prop :: [Int] -> Bool 187 | reverse_reverse_prop xs = 188 | reverse (reverse xs) == xs 189 | 190 | reverse_does_nothing :: [Int] -> Bool 191 | reverse_does_nothing xs = 192 | reverse xs == xs 193 | 194 | reverse_append :: [Int] -> [Int] -> Bool 195 | reverse_append xs ys = 196 | reverse (xs ++ ys) == reverse ys ++ reverse xs 197 | 198 | slow_reverse :: [a] -> [a] 199 | slow_reverse [] = [] 200 | slow_reverse (x:xs) = slow_reverse xs ++ [x] 201 | 202 | reverse_eq_slow_reverse :: [Int] -> Bool 203 | reverse_eq_slow_reverse xs = 204 | reverse xs == slow_reverse xs 205 | 206 | ---------------------------------------------------------------------- 207 | isSorted :: Ord a => [a] -> Bool 208 | isSorted [] = True 209 | isSorted [x] = True 210 | isSorted (x:y:ys) = x <= y && isSorted (y:ys) 211 | 212 | insert_preserves_sortedness :: Int -> [Int] -> Bool 213 | insert_preserves_sortedness x xs = 214 | isSorted (insert x (makeSorted 0 xs)) 215 | 216 | makeSorted :: Int -> [Int] -> [Int] 217 | makeSorted i [] = [] 218 | makeSorted i (x:xs) = y : makeSorted y xs 219 | where y = i + abs x 220 | 221 | makeSorted_prop :: [Int] -> Bool 222 | makeSorted_prop xs = 223 | isSorted (makeSorted 0 xs) 224 | 225 | 226 | ---------------------------------------------------------------------- 227 | data Tree a 228 | = TLeaf 229 | | TNode (Tree a) a (Tree a) 230 | deriving (Show, Eq) 231 | 232 | instance Arbitrary a => Arbitrary (Tree a) where 233 | arbitrary = genTree 3 234 | 235 | genTree :: Arbitrary a => Int -> Gen (Tree a) 236 | genTree 0 = return TLeaf 237 | genTree n = frequency [ (3, do l <- genTree (n-1) 238 | x <- arbitrary 239 | r <- genTree (n-1) 240 | return (TNode l x r)) 241 | , (1, return TLeaf) 242 | ] 243 | 244 | 245 | -} 246 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # CS316 "Functional Programming" 2 | 3 | Welcome to the webpage for The University of Strathclyde CS316 "Functional Programming"! 4 | 5 | This course has a [Twitter account](https://twitter.com/StrathCS316). 6 | 7 | *Assessment:* this course is entirely assessed by coursework. There are four exercises that you will complete (details below). For the 2nd, 3rd, and 4th exercises, you will do roughly 60% of the exercise at home or in the labs, and the 40% is done in exam conditions in the lab. 8 | 9 | See the [schedule](schedule.txt). 10 | 11 | ## Contact 12 | 13 | **Bob Atkey** LT1305 [robert.atkey@strath.ac.uk](mailto:robert.atkey@strath.ac.uk) 14 | 15 | ## Lectures 16 | 17 | Lectures are at **11am Tuesdays** in LT1415 and **11am Fridays** in LT412. 18 | 19 | See the [schedule](schedule.txt) for more details. 20 | 21 | Most of the lectures will involve us doing live coding. We will place the code from each lecture in this repository after each lecture, interspersed with commentary covering what we talked about. 22 | 23 | - [Lecture 01](lectures/Lec01.hs) : Data and Pattern Matching 24 | - [Lecture 02](lectures/Lec02.hs) : Defining functions 25 | - [Lecture 03](lectures/Lec03.hs) : List comprehensions 26 | - [Lecture 04](lectures/Lec04.hs) : Recursive functions 27 | - [Lecture 05](lectures/Lec05.hs) : Higher-order functions 28 | - [Lecture 06](lectures/Lec06Live.hs) : Declaring types and classes 29 | - [Lecture 07](lectures/Lec07.hs) : QuickCheck 30 | - [Lecture 08](lectures/Lec08.hs) : Recursion Schemes 31 | - [Lecture 09](lectures/Lec09.hs) : Functors and Containers 32 | - [Lecture 10](lectures/Lec10.hs) : Building Pure Evaluators 33 | - [Lecture 11](lectures/Lec11Live.hs) : (better notes pending) Monads and Applicatives 34 | - [Lecture 12](lectures/Lec12Live.hs) : (better notes pending) Monads we Like 35 | - [Lecture 13](lectures/Lec13Live.hs) : Parser Combinators 36 | - [Lecture 14](lectures/Lec14Live.hs) : More Parser Combinators 37 | - [Lecture 15](lectures/Lec15Live.hs) : Parsing expressions and JSON 38 | - [Lecture 16](lectures/Lec16.hs) : Traversing Containers 39 | - [Lecture 17](lectures/Lec17.hs) : Infinite Data and Processes 40 | - Lecture 18 : [Previ.se](https://previ.se/) Guest Lecture (see MyPlace for the slides) 41 | - [Lecture 19](lectures/Lec19.hs) : Parallelism 42 | - [Lecture 20](lectures/Lec20.hs) : Concurrency 43 | - [Lecture 21](https://github.com/pigworker/CS410-18) : A look at Agda (CS410 propaganda) 44 | 45 | ### Tutorials 46 | 47 | In addition to the lectures, there are weekly tutorials at **4pm on Thursdays** in [LT210](http://www.learningservices.strath.ac.uk/avfacilities/roomresults.asp?&menu1=Graham%20Hills&roomField=GH816&findRoom=Show+room+details). These are intended for going through some unassessed homework questions that we will set after the lectures, or for you to ask questions about the assessed exercises. 48 | 49 | - [Tutorial 02](tutorials/Tut02.md) : Some questions for the tutorial on Thursday 4th October. 50 | 51 | - [Tutorial 05](tutorials/Tut05.md) : Covered `iterList` (like `iterTree` in Exercise 3) and a short introduction to parser combinators. [Haskell code](tutorials/Tut05Live.hs). 52 | 53 | - [Tutorial 08](tutorials/Tut08.hs) : State monad and counting change. 54 | 55 | ### One minute papers 56 | 57 | At every lecture and tutorial, we will hand out "One minute papers" (OMPs) for you to provide us with feedback on the lecture -- what you have learned in this lecture and what we could have explained better. At the start of the next lecture, we will go through the OMPs from last time and try to address the feedback you give us. 58 | 59 | Students registered on the course can see their OMPs on the [Marx system](https://personal.cis.strath.ac.uk/conor.mcbride/shib/Marx/?page=CS316). 60 | 61 | ## Coursework 62 | 63 | As mentioned above, this course is entirely assessed by coursework. The split between the four exercises is shown below: 64 | 65 | - Exercise 1 (5%) : [The evaluation game](https://personal.cis.strath.ac.uk/robert.atkey/terms.html). Once you have finished, enter your username and you will get a password. Email this to me (email address above) by the deadline (Thursday 27th September, 4pm). 66 | 67 | - Exercise 2 (30%) : [First Order Programming](exercises/Ex2.hs). This was released on Thursday 27th September (week 2), and the final deadline and test are on Monday 15th October (week 5). 68 | 69 | - Exercise 3 (30%) : [Higher Order Programming](exercises/Ex3.hs). This was released on Thursday 11th October (week 4), and the final deadline and test are on Monday 5th November (week 8). 70 | 71 | - Exercise 4 (35%) : [GHOUL](exercises/Ex4.hs). This was be released on Thursday 1st November (week 7), and the final deadline and test are on Monday 26th November (week 11). 72 | 73 | - See the example GHOUL programs [plus](exercises/plus.ghoul), [double](exercises/double.ghoul), and [multiply](exercises/multiply.ghoul). 74 | 75 | After each of the exercises has been marked, we will email you your marks, and also put them on the [Marx system](https://personal.cis.strath.ac.uk/conor.mcbride/shib/Marx/?page=CS316) for you to see. 76 | 77 | ### Git commands 78 | 79 | To clone a local copy of this git repository, execute 80 | 81 | ``` 82 | git clone https://github.com/bobatkey/CS316-18/ 83 | ``` 84 | 85 | ## Helpful Links 86 | 87 | ### Videos 88 | 89 | - [What is a Monad? - Computerphile](https://www.youtube.com/watch?v=t1e8gqXLbsU). Graham Hutton (author of the programming in Haskell book linked below) explains Monads. 90 | 91 | ### The History of Haskell 92 | 93 | - [A History of Haskell: Being Lazy With Class](http://haskell.cs.yale.edu/wp-content/uploads/2011/02/history.pdf) is an account of the history of the Haskell language and how it got it's name. 94 | 95 | ### Other Lecture Courses 96 | 97 | These links are to lecture courses by other Universities and companies. You might find them useful as alternative presentations of the material in our course. 98 | 99 | - Glasgow uni (free!) MOOC on [Functional programming in Haskell](https://www.futurelearn.com/courses/functional-programming-haskell). 100 | 101 | - Video lectures by Erik Meijer on [Functional Programming Fundamentals](https://channel9.msdn.com/Series/C9-Lectures-Erik-Meijer-Functional-Programming-Fundamentals). 102 | 103 | - Material from [CIS 194: Introduction to Haskell](http://www.seas.upenn.edu/~cis194/fall16/) at the University of Pennsylvania. 104 | 105 | ### Books 106 | 107 | There are now many books written about Haskell. Here are links to some that we have found useful. 108 | 109 | - [Programming in Haskell](http://www.cs.nott.ac.uk/~pszgmh/pih.html) is the book that we have based the first half of this course on. You do not need to buy the book. 110 | 111 | - The [Haskell Wikibook](https://en.wikibooks.org/wiki/Haskell). This is a free online book that starts very gently, but also includes some very advanced material. 112 | 113 | - [Parallel and Concurrent Programming in Haskell](https://www.oreilly.com/library/view/parallel-and-concurrent/9781449335939/) by Simon Marlow. This book is an excellent description of the facilities in Haskell for parallel and concurrent programming. We will cover some of these in Lectures 19 and 20. The full text is available online for free reading. 114 | 115 | - [Learn You a Haskell for Great Good!](http://learnyouahaskell.com/). This is an introductory book on Haskell, covering roughly the same material as this course, but with a different presentation. There are attempts at humour, but you might find them grating after a while. The full text of this book is available online for free. 116 | -------------------------------------------------------------------------------- /exercises/Ex4Test.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -fwarn-incomplete-patterns #-} 2 | module Ex4Test where 3 | 4 | import qualified Data.Map as M 5 | import Data.Map (Map) 6 | import Ex4 7 | 8 | {----------------------------------------------------------------------} 9 | {- CS316 (2018/19) EXERCISE 4 : GHOUL -} 10 | {- -} 11 | {- * * * TEST QUESTIONS * * * -} 12 | {----------------------------------------------------------------------} 13 | 14 | -- Submit by committing to GitLab at or before 2pm on Monday 26th 15 | -- November. There will be a test on this exercise in the lab on that 16 | -- date. 17 | -- 18 | -- Your combined score from the submission and the test will be worth 19 | -- 35% of the overall marks for the class (so one mark, below is worth 20 | -- half a percent). 21 | -- 22 | -- This file contains the test questions. Answer the questions in this 23 | -- file, and make sure that both are committed to GitLab both by the 24 | -- end of the lab session. 25 | 26 | {- READ THIS FIRST: 27 | 28 | YOU NEED TO REPLACE THE LINE: 29 | 30 | module Main where 31 | 32 | AT THE START OF Ex4.hs WITH: 33 | 34 | module Ex4 where 35 | 36 | BEFORE PROCEEDING. -} 37 | 38 | {----------------------------------------------------------------------} 39 | {- Part 2 : PATTERN MATCHING -} 40 | {----------------------------------------------------------------------} 41 | 42 | {- 4.2.2 (a) Catch-all patterns 43 | 44 | GHOUL does not allow catch-all patterns that do not bind a variable 45 | like Haskell's '_'. Adjust the Pat datatype and the 'matchPattern' 46 | function, and your pattern parser 'pPat', to make the following kind 47 | of definition work: 48 | 49 | (alwaysOne _) -> (S Z) 50 | 51 | Write a summary of what you changed here so we know. -} 52 | 53 | {- 3 MARKS -} 54 | 55 | 56 | 57 | {- 4.2.2 (b) Repeated variables in patterns 58 | 59 | The basic version of GHOUL does not allow definitions like the 60 | following, where we repeat a variable name in the patterns to 61 | indicate that both arguments should be equal. 62 | 63 | (isEqual x x) -> True 64 | (isEqual x y) -> False 65 | 66 | This restriction is enforced by the 'bindVar' function that fails 67 | if a variable is matched more than once. Write a new version of 68 | bindVar that allows repeated binding of a variable, as long as the 69 | values matched are equal. -} 70 | 71 | bindVarAllowRepeats :: String -> Value -> Env -> ErrorOr Env 72 | bindVarAllowRepeats x v = 73 | undefined -- fill this in 74 | 75 | {- 2 MARKS -} 76 | 77 | {----------------------------------------------------------------------} 78 | {- Part 3: EVALUATION OF EXPRESSIONS -} 79 | {----------------------------------------------------------------------} 80 | 81 | {----------------------------------------------------------------------} 82 | {- 4.3.1 (a) Write a GHOUL program that reverses a list. See the 83 | function 'rev' defined in Lecture 02. You will need to also include 84 | the 'append' function from Question 4.0.0. You can either write the 85 | function in GHOUL syntax (as a string), or as a value of type 86 | 'Program'. -} 87 | 88 | revProg :: Program -- replace with 'String', if you want 89 | revProg = undefined 90 | 91 | {- Also write a test case for this program and the expected output here: 92 | 93 | 94 | -} 95 | 96 | {- 4 MARKS -} 97 | 98 | {- 4.3.1 (b) "Panic" function. Add a case to the 'eval' function that 99 | evaluates any function called 'panic' specially: it evaluates all 100 | the arguments, and then aborts (using 'abortEval') with an error 101 | message containing all the values that the arguments evaluated to 102 | pretty printed using 'ppValue'. 103 | 104 | Example: 105 | 106 | > runEval (eval M.empty (EA "panic" [EC "S" [EC "Z" []]])) [] 107 | Error "PANIC: (S Z)" 108 | 109 | > runEval (eval M.empty (EA "panic" [EA "panic" [EC "AARRGH" []]])) [] 110 | Error "PANIC: AARRGH" 111 | 112 | Write the changes you have made here: -} 113 | 114 | {- 3 MARKS -} 115 | {----------------------------------------------------------------------} 116 | 117 | {----------------------------------------------------------------------} 118 | {- Part 4 : PARSING -} 119 | {----------------------------------------------------------------------} 120 | 121 | {----------------------------------------------------------------------} 122 | {- 4.4.6 Desugaring lists 123 | 124 | GHOUL allows the user to create lists by explicitly using 'Cons' 125 | and 'Nil' constructors. For example, the program 126 | 127 | (main) -> (Cons A (Cons B (Cons C Nil))) 128 | 129 | returns the list [A B C]. 130 | 131 | However, GHOUL does not allow the user to use the nice syntax [A B 132 | C]. (Note that we're not using commas here, just like in the rest 133 | of GHOUL.) 134 | 135 | For this question, modify the parser you have written to allow list 136 | literals like '[]', '[A B C D]', '[(S Z) (S (S Z))]', '[(S Z) x]' 137 | to appear in patterns and expressions. The parser should convert 138 | list literals to the appropriate use of 'Cons' and 'Nil'. For 139 | example: 140 | 141 | > runParser pPat "[]" 142 | OK (PC "Nil" [],"") 143 | 144 | > runParser pPat "[A]" 145 | OK (PC "Cons" [PC "A" [],PC "Nil" []],"") 146 | 147 | > runParser pPat "[A B]" 148 | OK (PC "Cons" [PC "A" [],PC "Cons" [PC "B" [],PC "Nil" []]],"") 149 | 150 | > runParser pPat "[x]" 151 | OK (PC "Cons" [PV "x",PC "Nil" []],"") 152 | 153 | > runParser pPat "[x y]" 154 | OK (PC "Cons" [PV "x",PC "Cons" [PV "y",PC "Nil" []]],"") 155 | 156 | > runParser pPat "[(S Z) x (S (S Z))]" 157 | OK (PC "Cons" [PC "S" [PC "Z" []],PC "Cons" [PV "x",PC "Cons" [PC "S" [PC "S" [PC "Z" []]],PC "Nil" []]]],"") 158 | 159 | and similar for expressions. 160 | 161 | NOTE: you do not need to alter the 'Pat' or 'Exp' datatypes, only 162 | the 'pPat' and 'pExp' functions, plus some auxillary functions 163 | (described below). 164 | 165 | HINT: First define an auxillary function called 'mkPatList' of type 166 | '[Pat] -> Pat' that takes a list of patterns and produces a single 167 | pattern using 'PC "Cons" [_, _]' and 'PC "Nil" []' (you fill in the 168 | '_'s). Then extend 'pPat' to recognise lists of patterns surrounded 169 | by square brackets and separated by spaces, and use 'mkPatList' to 170 | turn the list of patterns into a 'Pat'tern. Then do the same for 171 | 'Exp'ressions. 172 | 173 | Write the changes you made here: -} 174 | 175 | 176 | {- 6 MARKS -} 177 | {----------------------------------------------------------------------} 178 | 179 | {----------------------------------------------------------------------} 180 | {- 4.5.2 functionCheck 181 | 182 | Write a function that checks that all the function names used on the 183 | right-hand side of every rule have at least one equation defined 184 | for them in the program. 185 | 186 | For example: 187 | 188 | > functionCheck [] 189 | OK () 190 | 191 | > functionCheck [MkRule "main" [] (EA "notDefined" [])] 192 | Error "Function notDefined undefined" 193 | 194 | > functionCheck plusProgramAST 195 | OK () 196 | -} 197 | 198 | functionCheck :: Program -> ErrorOr () 199 | functionCheck = undefined 200 | 201 | {- 4 MARKS -} 202 | {----------------------------------------------------------------------} 203 | -------------------------------------------------------------------------------- /exercises/Ex3Test.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -fwarn-incomplete-patterns #-} 2 | module Ex3Test where 3 | 4 | import Prelude hiding (words, lines, unlines) 5 | import Text.Read 6 | import Ex3 7 | 8 | {----------------------------------------------------------------------} 9 | {- CS316 (2018/19) EXERCISE 3 : HIGHER-ORDER PROGRAMMING -} 10 | {- -} 11 | {- * * * TEST QUESTIONS * * * -} 12 | {----------------------------------------------------------------------} 13 | 14 | -- Submit by committing to GitLab at or before 2pm on Monday 5th 15 | -- November. There will be a test on this exercise in the lab on that 16 | -- date. 17 | -- 18 | -- Your combined score from the submission and the test will be worth 19 | -- 30% of the overall marks for the class (so one mark, below is worth 20 | -- half a percent). 21 | -- 22 | -- This file contains the test questions. Answer the questions in this 23 | -- file, and make sure that both are committed to GitLab both by the 24 | -- end of the lab session. 25 | 26 | {----------------------------------------------------------------------} 27 | {- 1. STRUCTURAL RECURSION ON TREES AND LISTS -} 28 | {----------------------------------------------------------------------} 29 | 30 | {- 3.1.4 Trees full of functions. -} 31 | 32 | {- Define 'applyTree', a function that takes a binary tree of binary 33 | functions, and a value to use for the leaves, and returns the value 34 | computed by recursively applying the function at each node to the 35 | values computed for its two sub-trees. 36 | 37 | For example: 38 | 39 | applyTree (Node (Node Leaf (+) Leaf) (*) (Node Leaf (+) Leaf)) 1 = 4 40 | 41 | because: (1 + 1) * (1 + 1) = 2 * 2 = 4. 42 | 43 | Define your 'applyTree' using 'iterTree'. -} 44 | 45 | applyTree :: Tree (Int -> Int -> Int) -> Int -> Int 46 | applyTree = undefined 47 | 48 | {- 2 MARKS -} 49 | 50 | {----------------------------------------------------------------------} 51 | {- 2. COMPARATORS AND SORTING -} 52 | {----------------------------------------------------------------------} 53 | 54 | {- 3.2.4 Using 'qsortWith' and the other functions above, write a 55 | function that sorts lists of '(Int,String)' on the length of the 56 | second element of each pair. -} 57 | 58 | sortOnSndLength :: [(Int,String)] -> [(Int,String)] 59 | sortOnSndLength = undefined 60 | 61 | {- Example: 62 | 63 | > sortOnSndLength [(1,"one"), (2,"two"), (3,"three"), (4,"four"), (5, "five"), (6, "six")] 64 | [(1,"one"),(2,"two"),(6,"six"),(4,"four"),(5,"five"),(3,"three")] 65 | -} 66 | 67 | {- 2 MARKS -} 68 | 69 | {----------------------------------------------------------------------} 70 | {- PART 3 : A PICTURE LANGUAGE -} 71 | {----------------------------------------------------------------------} 72 | 73 | {- 3.3.7 Boolean Combinations of Bitmaps. 74 | 75 | Implement the following functions that compute the 'AND', 'OR' and 76 | 'NOT' of two bitmaps of 'Bool's. 77 | 78 | Use your functions to create a bitmap consisting of a square of the 79 | given size with a circular hole in it. The hole should be smaller 80 | that the size of the square. -} 81 | 82 | andBMP :: Bitmap Bool -> Bitmap Bool -> Bitmap Bool 83 | andBMP = undefined 84 | 85 | orBMP :: Bitmap Bool -> Bitmap Bool -> Bitmap Bool 86 | orBMP = undefined 87 | 88 | notBMP :: Bitmap Bool -> Bitmap Bool 89 | notBMP = undefined 90 | 91 | squareWithARoundHole :: Double -> Bitmap Bool 92 | squareWithARoundHole r = undefined 93 | 94 | {- 5 MARKS -} 95 | 96 | {- 3.3.11 Flipping. Write functions that flip a 'Bitmap'. The first 97 | function should flip top to bottom (and bottom to top). The second 98 | should flip left to right (and right to left). 99 | 100 | Use 'transform' to write your functions. -} 101 | 102 | flipTopBottom :: Bitmap a -> Bitmap a 103 | flipTopBottom = undefined 104 | 105 | flipLeftRight :: Bitmap a -> Bitmap a 106 | flipLeftRight = undefined 107 | 108 | {- 2 MARKS -} 109 | 110 | {----------------------------------------------------------------------} 111 | {- 4. PROCESSES -} 112 | {----------------------------------------------------------------------} 113 | 114 | {- 3.4.2 Process translation. Here is the 'Process' type from Exercise 115 | 2, renamed to prevent a clash with our new 'Process' type. -} 116 | 117 | data BProcess 118 | = BEnd 119 | | BOutput Bool BProcess 120 | | BInput BProcess BProcess 121 | deriving Show 122 | 123 | {- Write a function that translates a 'BProcess' into a 'Process Bool 124 | ()'. Whenever the 'BProcess' ends, the 'Process Bool' process should 125 | end; whenever the 'BProcess' outputs, the 'Process Bool' process 126 | should output; and whenever the 'BProcess' inputs, the 'Process 127 | Bool' process should input. 128 | 129 | In the other direction, write a function that translates a 'Process 130 | Bool ()' to a 'BProcess'. -} 131 | 132 | bprocessToProcess :: BProcess -> Process Bool () 133 | bprocessToProcess = undefined 134 | 135 | processToBProcess :: Process Bool () -> BProcess 136 | processToBProcess = undefined 137 | 138 | {- 4 MARKS -} 139 | 140 | 141 | {- 3.4.4 Define a process that does the same thing as 'echo' above but 142 | only using 'input', 'output' and 'sequ'. -} 143 | 144 | echoFromSequ :: Process x () 145 | echoFromSequ = undefined 146 | 147 | {- 1 MARK -} 148 | 149 | 150 | {- 3.4.5 Sequencing without values. Some processes, like 'output x' 151 | don't return any interesting value (a bit like a function that 152 | returns 'void' in Java or C). In this case, using 'sequ' to 153 | sequence processes is a bit clumsy because we have to write an 154 | anonymous function that ignores its argument: 155 | 156 | p1 `sequ` \_ -> p2 157 | 158 | Write a function 'sequ_' that uses 'sequ' to sequence two processes 159 | where the output of the first is ignored. -} 160 | 161 | sequ_ :: Process x () -> Process x a -> Process x a 162 | sequ_ p1 p2 = undefined 163 | 164 | {- 1 MARK -} 165 | 166 | 167 | 168 | {- 3.4.9 Translation of processes. Sometimes, we might have a process 169 | that sends and receives values of type 'x', but we want a process 170 | that sends and receives values of type 'y'. Define a function 171 | 'translate' that takes two translation functions, one from 'x's to 172 | 'y's and one from 'y's to 'Maybe x's, and converts processes that 173 | communicate using 'x's into processes that communicate using 174 | 'y's. If the translation fails (because the second function returns 175 | 'Nothing'), then the process should abort by 'End'ing with Nothing. -} 176 | 177 | translate :: (x -> y) -> (y -> Maybe x) -> Process x a -> Process y (Maybe a) 178 | translate xToy yTox p = undefined 179 | 180 | {- 3 MARKS -} 181 | 182 | {- 3.4.10 Below we have defined functions stringToMaybeInt and 183 | intToString that translate back and forth between strings and 184 | integers. Use these functions and translate to define 185 | 'intsToStrings'. -} 186 | 187 | stringToInt :: String -> Maybe Int 188 | stringToInt = readMaybe 189 | 190 | intToString :: Int -> String 191 | intToString = show 192 | 193 | intsToStrings :: Process Int a -> Process String (Maybe a) 194 | intsToStrings = undefined 195 | 196 | {- 1 MARK -} 197 | 198 | {----------------------------------------------------------------------} 199 | {- END OF TEST -} 200 | {----------------------------------------------------------------------} 201 | -------------------------------------------------------------------------------- /lectures/Lec16.hs: -------------------------------------------------------------------------------- 1 | module Lec16 where 2 | 3 | import Prelude hiding (Traversable (..)) 4 | import Data.Foldable 5 | 6 | {- LECTURE 16 : VISITING AND TRAVERSING CONTAINERS 7 | 8 | Or : how do I write a 'foreach' loop in Haskell? 9 | 10 | for (String item : myList) { 11 | ... 12 | } 13 | 14 | This lecture is about how to iterate over the elements of a 15 | container (such as a list), performing some kind of "side 16 | effecting" operation on each element, and gathering all the results 17 | into a new container. 18 | 19 | We have already seen a pattern like this with the 'Functor' 20 | interface from Lecture 09. The Functor type class contains a single 21 | method: 22 | 23 | class Functor c where 24 | fmap :: (a -> b) -> c a -> c b 25 | 26 | Instances of 'Functor' include lists, so we have a function: 27 | 28 | fmap :: (a -> b) -> [a] -> [b] 29 | 30 | that applies a function to every element of the list, producing a 31 | new list with the results. 32 | 33 | Because Haskell is a "pure" language, 'fmap' is quite restricted in 34 | what it can do. For instance, we can't throw exceptions while 35 | transforming each element, or do printing, or ask the user for 36 | input. 37 | 38 | Concretely, let's assume we have the following problem: 39 | 40 | - We have a list of values 'vals :: [a]' 41 | 42 | - We have a function 'f :: a -> Maybe b' 43 | 44 | - We want to: 45 | 46 | (a) find out if all the 'a's in 'vals' are OK (i.e. 'f' does 47 | not return 'Nothing') 48 | 49 | (b) if so, make a new version of 'vals' of type '[b]' 50 | 51 | For complete concreteness, let's say we have a list of strings, 52 | such as one of the two following lists: -} 53 | 54 | strings1 :: [String] 55 | strings1 = ["1", "2", "3"] 56 | 57 | strings2 :: [String] 58 | strings2 = ["1", "two", "3"] 59 | 60 | {- And we have a checking function: -} 61 | 62 | toDigit :: String -> Maybe Int 63 | toDigit "0" = Just 0 64 | toDigit "1" = Just 1 65 | toDigit "2" = Just 2 66 | toDigit "3" = Just 3 67 | toDigit "4" = Just 4 68 | toDigit "5" = Just 5 69 | toDigit "6" = Just 6 70 | toDigit "7" = Just 7 71 | toDigit "8" = Just 8 72 | toDigit "9" = Just 9 73 | toDigit _ = Nothing 74 | 75 | {- Our goal is to write a function, and then generalise a function of 76 | the following type: 77 | 78 | checkAll :: (a -> Maybe b) -> [a] -> Maybe [b] 79 | 80 | so that: 81 | 82 | checkAll toDigit strings1 == Just [1, 2, 3] :: Maybe [Int] 83 | 84 | and: 85 | 86 | checkAll toDigit strings2 = Nothing :: Maybe [Int] 87 | 88 | We expect 'Just' on 'strings1' because for all of the elements, 89 | 'toDigit' returns 'Just' something. We expect 'Nothing' on 90 | 'strings2' because one of the elements ("two") causes 'toDigit' to 91 | return 'Nothing'. -} 92 | 93 | {- Part 1 : The 'Direct' Way 94 | 95 | Let's write this function the 'direct' way by using 'case' to do 96 | pattern matching: -} 97 | 98 | checkAll0 :: (a -> Maybe b) -> [a] -> Maybe [b] 99 | checkAll0 f [] = Just [] 100 | checkAll0 f (x:xs) = 101 | case f x of 102 | Nothing -> Nothing 103 | Just y -> 104 | case checkAll0 f xs of 105 | Nothing -> Nothing 106 | Just ys -> Just (y:ys) 107 | 108 | {- Let's test it: 109 | 110 | > checkAll0 toDigit strings1 111 | Just [1,2,3] 112 | > checkAll0 toDigit strings2 113 | Nothing 114 | 115 | Seems to work! 116 | 117 | However, 'checkAll0' is a little messy -- there's a cascade of 118 | 'case' expressions that does nothing but make sure that if either 119 | running 'f' or checking the rest of the list return 'Nothing', then 120 | the whole thing returns 'Nothing'. We've seen a pattern like this 121 | before in Lectures 10 and 11, and we saw how to use Applicative 122 | functors to make it tidier. Instead of writing out a cascade of 123 | 'case's, we realise that what we want to do on each element of the 124 | list is: 125 | 126 | - call 'f' on 'x' 127 | - call 'checkAll0 f' on 'xs' 128 | - combine the results with ':' to make a list 129 | - if any of the above returns 'Nothing', we return 'Nothing' 130 | 131 | We can achieve this by writing the function using the Applicative 132 | Functor methods 'pure' and '<*>': -} 133 | 134 | checkAll1 :: (a -> Maybe b) -> [a] -> Maybe [b] 135 | checkAll1 f [] = pure [] 136 | checkAll1 f (x:xs) = pure (:) <*> f x <*> checkAll1 f xs 137 | 138 | {- First, let's test it: 139 | 140 | > checkAll1 toDigit strings1 141 | Just [1,2,3] 142 | > checkAll1 toDigit strings2 143 | Nothing 144 | 145 | Seems to work! Why does this work? Let's look at the types. 146 | 147 | In the first case, 'pure' (specialised to 'Maybe') has type 'a -> 148 | Maybe a', so we can use it to turn an ordinary value '[]' of type 149 | '[b]' into a 'Maybe [b]'. 150 | 151 | In the second case, we need to remember that '<*>' has the type: 152 | 153 | <*> :: Maybe (a -> b) -> Maybe a -> Maybe b 154 | 155 | '<*>' acts like a kind of enhanced function application: instead of 156 | just applying a function of type 'a -> b' to a value of type 'a', 157 | it applies a function wrapped in a 'Maybe' to a value wrapped in a 158 | 'Maybe'. Compare this to the 'bitmapApply' and 'procApply' 159 | functions from Exercise 3. 160 | 161 | In 'checkAll1', we have: 162 | 163 | pure (:) :: Maybe (b -> [b] -> [b]) 164 | f x :: Maybe b 165 | checkAll1 f xs :: Maybe [b] 166 | 167 | So, using '<*>' we can apply 'pure (:)' to 'f x' and 'checkAll1 f 168 | xs' to get a value of type 'Maybe [b]'. By using 'pure' and '<*>' 169 | we have not had to write out a lot of plumbing code to make sure 170 | 'Just's and 'Nothing's go to the right places, we can rely on the 171 | Maybe instance for Applicative. 172 | 173 | It is worth comparing the code of 'checkAll1' to the code for 'map' 174 | for lists (renamed to 'map0' here to avoid a name clash): -} 175 | 176 | map0 :: (a -> b) -> [a] -> [b] 177 | map0 f [] = [] 178 | map0 f (x:xs) = f x : map0 f xs 179 | 180 | {- If we remember that the expression 'f x : map0 f xs' is equivalently 181 | written as: 182 | 183 | (:) (f x) (map0 f xs) 184 | 185 | So the whole function could be written as: -} 186 | 187 | map1 :: (a -> b) -> [a] -> [b] 188 | map1 f [] = [] 189 | map1 f (x:xs) = (:) (f x) (map0 f xs) 190 | 191 | {- Then the similarity with 'checkAll1' becomes a matter of replacing 192 | the 'pure' and '<*>' in 'checkAll1' with whitespace -- function 193 | application in Haskell is so common that it is written with no 194 | syntax at all, but if we want function applicatio with side effects 195 | then we need to insert 'pure' and '<*>' in the right places. 196 | 197 | Comparing 'map1' and 'checkAll1', we can see that 'checkAll1' is 198 | really a kind of 'map' but with side effects. 'checkAll1' is 199 | restricted to the side effect being "might throw an error", but 200 | this restriction is artificial. -} 201 | 202 | 203 | {- Part 2 : Generalising to other side effects 204 | 205 | Looking at 'checkAll1', we can see that not only does it not 206 | mention 'Nothing' and 'Just' explicitly, it isn't specific to 207 | 'Maybe' at all. Indeed, if we comment out the type declaration for 208 | 'checkAll1' and ask GHCi what type it ought to have, then we get a 209 | more general type than the one written above: 210 | 211 | > :t checkAll1 212 | checkAll1 :: Applicative f => (t1 -> f t) -> [t1] -> f [t] 213 | 214 | Let's write a new version of 'checkAll1' that uses this more 215 | general type signature (with nicer choices for the type names), but 216 | keeps exactly the same code: -} 217 | 218 | checkAll :: Applicative f => (a -> f b) -> [a] -> f [b] 219 | checkAll f [] = pure [] 220 | checkAll f (x:xs) = pure (:) <*> f x <*> checkAll f xs 221 | 222 | {- This new version now works for any Applicative Functor, and so many 223 | kinds of possible 'side effect'. For example, we can write a 224 | function that does I/O to ask the user whether to allow a number or 225 | to negate it: -} 226 | 227 | askUser :: Int -> IO Int 228 | askUser i = 229 | do putStrLn ("What about: " ++ show i ++ "?") 230 | response <- getLine 231 | case response of 232 | "negate" -> pure (-i) 233 | _ -> pure i 234 | 235 | {- Now running 'checkAll' with 'askUser' asks the user for their 236 | opinion on each element of the input list: 237 | 238 | > checkAll askUser [1,2,3] 239 | What about: 1? 240 | negate 241 | What about: 2? 242 | ok 243 | What about: 3? 244 | negate 245 | [-1,2,-3] 246 | 247 | So, checkAll is now a general function for 'mapping over' a list 248 | whilst performing some side effects. Since the side effects may be 249 | arbitrary and not just 'Maybe', the name 'checkAll' is now 250 | inappropriate. Following Haskell tradition, we should call this 251 | function 'traverse', but we won't due to name clashes with the 252 | standard library: -} 253 | 254 | traverse0 :: Applicative f => (a -> f b) -> [a] -> f [b] 255 | traverse0 f [] = pure [] 256 | traverse0 f (x:xs) = pure (:) <*> f x <*> traverse0 f xs 257 | 258 | {- (This has exactly the same code as 'checkAll1' and 'checkAll', but 259 | now the name is more sensible.) -} 260 | 261 | {- Now that we have identified 'traverse0' as a sensible function, we 262 | can think of other specialised versions of it. For example, if we 263 | swap the order of the arguments, then we get a function that we can 264 | think of as a kind of Java-style 'for (Item i : container) {...}' 265 | loop (again a '0' is appended to the name to avoid a name clash): -} 266 | 267 | for0 :: Applicative f => [a] -> (a -> f b) -> f [b] 268 | for0 xs f = traverse0 f xs 269 | 270 | {- For example: 271 | 272 | > for0 [1,2,3] askUser 273 | What about: 1? 274 | negate 275 | What about: 2? 276 | nothing 277 | What about: 3? 278 | nothing 279 | [-1,2,3] 280 | 281 | Or, more explicitly: 282 | 283 | > for0 [1,2,3] (\i -> askUser i) 284 | What about: 1? 285 | nothing 286 | What about: 2? 287 | negate 288 | What about: 3? 289 | meh 290 | [1,-2,3] 291 | -} 292 | 293 | 294 | 295 | {- Part 3 : Generalising to other containers 296 | 297 | Just as 'map' can be generalised from lists to lots of other kinds 298 | of container, 'traverse' can be as well. 299 | 300 | For example, here are 'Tree's again, and 'map' for trees, as we saw 301 | in Lecture 09 and Exercise 3: -} 302 | 303 | data Tree a 304 | = Leaf 305 | | Node (Tree a) a (Tree a) 306 | deriving Show 307 | 308 | mapTree :: (a -> b) -> Tree a -> Tree b 309 | mapTree f Leaf = Leaf 310 | mapTree f (Node l x r) = Node (mapTree f l) (f x) (mapTree f r) 311 | 312 | {- And here is the corresponding 'traverseTree', which is similar to 313 | 'mapTree', except for the addition of 'pure' and '<*>' at the right 314 | places. -} 315 | 316 | traverseTree :: Applicative f => (a -> f b) -> Tree a -> f (Tree b) 317 | traverseTree f Leaf = pure Leaf 318 | traverseTree f (Node l x r) = pure Node <*> traverseTree f l <*> f x <*> traverseTree f r 319 | 320 | {- We can go on to define 'traverse' like functions for almost all 321 | containers, such as Maybe and the standard library's Data.Map.Map 322 | type. 323 | 324 | EXERCISE: define 325 | 'traverseMaybe :: Applicative f => (a -> f a) -> Maybe a -> f (Maybe b)' 326 | 327 | Now we can spot a recurring pattern -- many containers have a 328 | 'traverse'-like function. Just as we did for 'mapList', 'mapTree', 329 | 'mapMaybe' etc., we can gather all these examples up into a single 330 | type class that will allow us to write functions that are generic 331 | in the actual container being used. We call this type class 332 | 'Traversable': -} 333 | 334 | class Traversable c where 335 | traverse :: Applicative f => (a -> f b) -> c a -> f (c b) 336 | 337 | {- (This type class is defined in the standard library, but I have 338 | hidden the standard definition in the 'import' declarations above 339 | so that I can repeat it here. The standard one differs in that it 340 | requires all Traversables to also be Foldable and Functor (Lecture 341 | 09), but I'll ignore that here.) 342 | 343 | Now list and 'Tree's (and 'Maybe') are all instances of 344 | 'Traversable': -} 345 | 346 | instance Traversable [] where 347 | traverse f [] = pure [] 348 | traverse f (x:xs) = pure (:) <*> f x <*> traverse f xs 349 | 350 | instance Traversable Tree where 351 | traverse f Leaf = pure Leaf 352 | traverse f (Node l x r) = pure Node <*> traverse f l <*> f x <*> traverse f r 353 | 354 | {- EXERCISE: write an instance of Traversable for Maybe -} 355 | 356 | {- EXERCISE: can you write 'fmap' if you are given 'traverse'? -} 357 | 358 | 359 | 360 | {- Once we have identified 'Traversable' as a type class, we can write 361 | some generic functions that use 'traverse' in various ways. For 362 | example, the 'for0' function above works for all 'Traversable's: -} 363 | 364 | for :: (Traversable c, Applicative f) => c a -> (a -> f b) -> f (c b) 365 | for c f = traverse f c 366 | 367 | {- Now we can write a generic function that traverses over any 368 | Traversable container of integers, and prints out all the items 369 | contained within: -} 370 | 371 | outputNumbers :: Traversable c => c Int -> IO (c Int) 372 | outputNumbers c = 373 | for c (\i -> do print i; return i) 374 | 375 | {- For example: 376 | 377 | > outputNumbers [1,2,3] 378 | 1 379 | 2 380 | 3 381 | [1,2,3] 382 | > outputNumbers (Node Leaf 1 (Node Leaf 2 Leaf)) 383 | 1 384 | 2 385 | Node Leaf 1 (Node Leaf 2 Leaf) 386 | -} 387 | 388 | {- Another useful function is 'sequence' (called 'sequenceA' for 389 | historical reasons), which takes a container of tasks to a task of 390 | containers (thinking of a value of type 'f a' where 'f' is an 391 | Applicative Functor as a "task" that produces a value of type 'a'): -} 392 | 393 | sequence :: (Applicative f, Traversable c) => c (f a) -> f (c a) 394 | sequence c = traverse id c 395 | 396 | myTasks = [ putStrLn "Task 1" 397 | , do { line <- getLine; putStrLn ("You said " ++ line) } 398 | , do { putStrLn "Task 3" } 399 | ] 400 | -------------------------------------------------------------------------------- /lectures/Lec04.hs: -------------------------------------------------------------------------------- 1 | module Lec04 where 2 | 3 | {- LECTURE 04 : RECURSIVE FUNCTIONS 4 | 5 | In Lecture 02 we looked at how to define functions in Haskell, and 6 | several techniques for reasoning our way from a specification to an 7 | implementation. In this lecture, we'll look in more detail at 8 | *recursive* functions. 9 | 10 | A recursive function is one that is defined in terms of 11 | itself. This mirrors the structure of some of the types of data we 12 | have looked at so far. For example, lists are defined to be either 13 | empty, or made from an element plus more list. To define functions 14 | that operate on recursively defined data, we need recursively 15 | defined functions. 16 | 17 | We have already three recursively defined functions in Lecture 03: 18 | 'gcd', 'append', 'rev', and 'sawPrefix'. Of these, 'gcd' is in some 19 | ways the most complex because there was no obvious connection 20 | between the input data and the data passed to the next call to 21 | 'gcd'. In contrast, the 'append' and 'rev' functions always called 22 | themselves on immediate sublists of the input. This kind of 23 | recursion "on the structure of the input" is called "structural 24 | recursion". Structurally recursive functions are often easier to 25 | understand than non-structurally recursive ones. 26 | 27 | In this lecture, we'll see other examples of structural vs 28 | non-structural recursion, and a way to turn non-structural 29 | recursion into structural recursion by introducing an intermediate 30 | data structure. -} 31 | 32 | {- PART I : INSERTION SORT 33 | 34 | Consider the problem of inserting a value into a sorted list, so 35 | that the resulting list is still sorted. If we assume that the 36 | input list is sorted in ascending order, then there are three cases 37 | to consider: 38 | 39 | 1) insertion into the empty list -- we return a list with one 40 | element 41 | 42 | 2) insertion into a list when the head is greater than the 43 | element to be inserted -- we return the new element as the 44 | head of the result, with the input list as the tail. 45 | 46 | 3) insertion into a list when the head is less than the element 47 | to be inserted -- we return the head followed by the 48 | insertion of the element into the rest of the list. 49 | 50 | We can write this function using a mixture of pattern matching to 51 | look at the structure of the list and 'if-then-else's to do the 52 | comparisons: -} 53 | 54 | insert :: Ord a => a -> [a] -> [a] 55 | insert x [] = [x] 56 | insert x (y:ys) = if x <= y 57 | then x : y : ys 58 | else y : insert x ys 59 | 60 | {- Note that this function is structurally recursive: when we call 61 | 'insert' inside the definition of 'insert', we are using a value 62 | ('ys') we got from the input. Therefore, we can say that 'insert' 63 | follows the structure of its input. 64 | 65 | We can see how 'insert' operates by writing out a trace of how it 66 | works on an example list: 67 | 68 | insert 3 [1,4] 69 | = 70 | 1 : insert 3 [4] 71 | = 72 | 1 : 3 : 4 : [] 73 | = 74 | [1,3,4] 75 | 76 | Using 'insert', we can write a sorting function by repeatedly 77 | inserting each element into a sorted list. Again, we can define 78 | this function by structural recursion on the input list: -} 79 | 80 | isort :: Ord a => [a] -> [a] 81 | isort [] = [] 82 | isort (x:xs) = insert x (isort xs) 83 | 84 | {- The advantage of using structural recursion is that it is easier to 85 | reason that 'isort' always produces sorted lists which have the 86 | same elements as the input: 87 | 88 | - when the input is [], we return [], which is sorted. 89 | 90 | - when the input is 'x:xs', we sort 'xs', and then insert 'x' 91 | into the result. Since insertion into a sorted list always 92 | gives us a sorted list, we know that the overall result is 93 | sorted. Also, 'insert' inserts the element exactly once, so we 94 | know that the result has the same elements as the input. 95 | 96 | However, 'isort' has a problem, which we can see by writing out the 97 | trace of sorting a reversed list and writing the number of steps 98 | each time: 99 | 100 | isort [3,2,1] 101 | = { 4 } 102 | insert 3 (insert 2 (insert 1 [])) 103 | = { 1 } 104 | insert 3 (insert 2 [1]) 105 | = { 2 } 106 | insert 3 [1,2] 107 | = { 3 } 108 | [1,2,3] 109 | 110 | From this, we can see that 'isort' effectively transforms its input 111 | into a list of 'insert' jobs. Because the initial list was in 112 | reverse order, each 'insert' job has to go right to the end to 113 | insert its element. This means that we take a number of steps 114 | proportional to the square of the input list to accomplish the 115 | sort. Can we do better? -} 116 | 117 | {- PART II : QUICKSORT 118 | 119 | An algorithm for sorting that is, sometimes, faster than insertion 120 | sort is Hoare's QuickSort algorithm. QuickSort works by dividing 121 | the input into two large chunks and then sorting those 122 | independently. Therefore, it can be more efficient than insertion 123 | sort, which always splits the input into one very small chunk (the 124 | head) and the rest. 125 | 126 | We can write a short implementation of a simple version of 127 | QuickSort in Haskell. As above, sorting the empty list yields the 128 | empty list. To sort a list with an element 'x', we split it into 129 | two lists: 'smaller', which contains everything less than 'x', and 130 | 'larger', which contains everything greater than or equal to 'x', 131 | then we sort those lists and stick everything back together using 132 | the built-in append function '++': -} 133 | 134 | qsort :: Ord a => [a] -> [a] 135 | qsort [] = [] 136 | qsort (x:xs) = qsort smaller ++ [x] ++ qsort larger 137 | where smaller = [ y | y <- xs, y < x] 138 | larger = [ y | y <- xs, y >= x] 139 | 140 | {- We have used a new construct here: 'where' allows us to split out 141 | parts of a definition and write them separately. We could have 142 | written the second case of 'qsort' as: 143 | 144 | qsort (x:xs) = qsort [ y | y <- xs, y < x] ++ [x] ++ qsort [ y | y <- xs, y >= x] 145 | 146 | instead of naming the two lists 'smaller' and 'larger'. However, 147 | using 'where' allows us to be clearer about why we are doing 148 | certain things by giving them names. (It is also more efficient if 149 | we use the same thing more that once.) 150 | 151 | ASIDE: Unfortunately, this isn't a very good implementation of 152 | QuickSort, and some might say it is not really QuickSort at 153 | all. QuickSort, as originally defined by Hoare, operated on arrays 154 | and sorted in instead of creating (a lot of) new lists as this 155 | implementation does. For more informaton / opinions, see: 156 | 157 | https://stackoverflow.com/questions/7717691/why-is-the-minimalist-example-haskell-quicksort-not-a-true-quicksort 158 | 159 | Also the way that the pivot element is selected in this 160 | implementation is very naive, and can often yield the same worst 161 | case time behaviour as insertion sort. Nevertheless, it is a good 162 | example of a non-structurally recursive function for our purposes. 163 | 164 | END OF ASIDE. 165 | 166 | The definition of 'qsort' is all very well, but it is not 167 | structurally recursive. We call 'qsort' recursively on lists that 168 | are computed via a (relatively) complex list comprehension, and not 169 | just ones that are discovered by pattern matching. This makes it 170 | harder to see that 'qsort' is definitely doing the right 171 | thing. 172 | 173 | To help us see what is going on inside 'qsort', let's step through 174 | an example: 175 | 176 | 177 | qsort [5,3,1,2] 178 | = 179 | qsort [3,1,2] ++ [5] ++ qsort [] 180 | = 181 | (qsort [1,2] ++ [3] ++ qsort []) ++ [5] ++ [] 182 | = 183 | (qsort [1,2] ++ [3] ++ qsort []) ++ [5] ++ [] 184 | = 185 | ((qsort [] ++ [1] ++ qsort [2]) ++ [3] ++ []) ++ [5] ++ [] 186 | = 187 | (([] ++ [1] ++ ([] ++ [2] ++ [])) ++ [3] ++ []) ++ [5] ++ [] 188 | = 189 | [1,2,3,5] 190 | 191 | We have formatted this example to reveal some of the internal 192 | structure of the tasks that 'qsort' generates. Looking at the final 193 | structure of the appends ('++'s) at the end, we can see that there 194 | is a tree structure: 195 | 196 | [5] 197 | [3] [] 198 | [1] [] 199 | [] [2] 200 | [] [] 201 | 202 | Let's now see how to reformulate 'qsort' in terms of intermediate 203 | tree data structure, which will help us make a structurally 204 | recursive variant. -} 205 | 206 | {- PART III : TREESORT 207 | 208 | We want to represent binary trees, so we create a new data type for 209 | this purpose. We name this data type 'BST' for Binary Search Tree 210 | to indicate that we want it to have a special property with respect 211 | to sortedness. Specifically, a tree is a binary search tree if: 212 | 213 | 1. it is 'Leaf'; or 214 | 215 | 2. it is 'Node l x r' and all of the following are true: 216 | (a) every value in l is <= x 217 | (b) every value in r is >= x 218 | (c) l is a binary search tree 219 | (d) r is a binary search tree 220 | -} 221 | 222 | data BST a 223 | = Leaf 224 | | Node (BST a) a (BST a) 225 | deriving Show 226 | 227 | {- We will build up our 'BST's by inserting elements into them, 228 | maintaining the properties listed above. This insertion function is 229 | analogous to the 'insert' function on lists we defined above. As 230 | above, there are three cases: 231 | 232 | 1. The tree is empty: we make a new tree with a single node; 233 | 234 | 2. The element at the root of the tree is less than the element 235 | we want to insert: we insert the element into the left hand 236 | (smaller) subtree; 237 | 238 | 3. The element at the root of the tree is greater than or equal 239 | to the element we want to insert: we insert the element into 240 | the right hand (larger) subtree. 241 | 242 | We write out these cases using pattern matching and guards. As with 243 | the 'insert' function above, this function is structurally 244 | recursive and we can check for each case that it (a) always returns 245 | a Binary Search Tree; and (b) the values in the result tree are all 246 | the values in the input tree, plus the new value. -} 247 | 248 | insertBST :: Ord a => a -> BST a -> BST a 249 | insertBST x Leaf = Node Leaf x Leaf 250 | insertBST x (Node smaller y larger) 251 | | x < y = Node (insertBST x smaller) y larger 252 | | otherwise = Node smaller y (insertBST x larger) 253 | 254 | {- As we saw above, 'qsort' operates by converting the input list into a 255 | tree of jobs to perform. We copy this idea by writing a (structurally 256 | recursive) function to convert a list to a tree by repeated 257 | insertion: -} 258 | 259 | listToTree :: Ord a => [a] -> BST a 260 | listToTree [] = Leaf 261 | listToTree (x:xs) = insertBST x (listToTree xs) 262 | 263 | {- We can see how this generates the same trees as qsort (after 264 | reversal, because it builds up the tree from the last element to 265 | the first): 266 | 267 | > listToTree (reverse [5,3,1,2]) 268 | Node (Node (Node Leaf 1 (Node Leaf 2 Leaf)) 3 Leaf) 5 Leaf 269 | 270 | This is exactly the Haskell representation of the qsort tree we 271 | drew above. 272 | 273 | Now, to convert a tree to a list, we 'flatten' it. You already saw 274 | this function in Exercise 1. We work on the structure of the tree, 275 | converting leaves to empty lists, and converting nodes to the 276 | concatenation of the smaller, middle bit, and larger parts: -} 277 | 278 | flatten :: BST a -> [a] 279 | flatten Leaf = [] 280 | flatten (Node smaller a larger) = 281 | flatten smaller ++ [a] ++ flatten larger 282 | 283 | {- Finally, we can put 'flatten' and 'listToTree' together to get the 284 | 'treesort' function: -} 285 | 286 | treesort :: Ord a => [a] -> [a] 287 | treesort xs = flatten (listToTree xs) 288 | 289 | 290 | {- PART IV : FLATTEN WITH AN ACCUMULATOR 291 | 292 | Unfortunately, the 'flatten' function defined above is not 293 | particularly efficient. It uses list append ('++') to create the 294 | output list. Let's recall from Lecture 03 how list append is 295 | defined. It is defined by structural recursion on its first 296 | argument: 297 | 298 | append :: [a] -> [a] -> [a] 299 | append [] ys = ys 300 | append (x:xs) ys = x : (append xs ys) 301 | 302 | This means that the number of steps required to perform an append 303 | is equal to the length of the first list. Since the result of a 304 | 'flatten' that is invoked by another 'flatten' may result in going 305 | over the same elements over and over again, just as in the repeated 306 | inserts having travel the whole length of the list as we saw above. 307 | 308 | A standard technique for making this kind of function faster is to 309 | use a separate 'accumulator' argument. Instead of repeatedly 310 | traversing the input to build the output, we incrementally build 311 | the output by passing partial output into the function and 312 | returning the updated partial output. 313 | 314 | Here is 'flatten2', 'flatten' written using an accumulator. We pass 315 | in a list that contains the partially constructed output, which we 316 | call 'acc'. In the 'Leaf' case, there is nothing to add, so we 317 | return 'acc'. In the 'Node' case, we (a) add the element from 318 | 'larger'; (b) add the element 'x'; and (c) add the elements from 319 | smaller: -} 320 | 321 | flatten2 :: BST a -> [a] -> [a] 322 | flatten2 Leaf acc = acc 323 | flatten2 (Node smaller x larger) acc = 324 | flatten2 smaller (x:flatten2 larger acc) 325 | 326 | {- We will see more examples of using accmulators in the next 327 | Tutorial. In the meantime, see if you can work out how 'flatten2' 328 | works by writing out how it operates on an example tree. 329 | 330 | We can use 'flatten2' as a drop-in replacement in treesort, as long 331 | as we remember to pass in the empty list as the initial partial 332 | output: -} 333 | 334 | treesort2 :: Ord a => [a] -> [a] 335 | treesort2 xs = flatten2 (listToTree xs) [] 336 | -------------------------------------------------------------------------------- /lectures/Lec03-data/birth.csv: -------------------------------------------------------------------------------- 1 | GeographyCode:CS-allbirths:CS-femalebirths:CS-malebirths 2 | S01003025:5:3:2 3 | S01003026:17:7:10 4 | S01003027:17:9:8 5 | S01003028:6:5:1 6 | S01003029:14:5:9 7 | S01003030:23:9:14 8 | S01003031:0:0:0 9 | S01003032:5:2:3 10 | S01003033:12:7:5 11 | S01003034:9:4:5 12 | S01003035:11:4:7 13 | S01003036:6:3:3 14 | S01003037:54:22:32 15 | S01003038:7:4:3 16 | S01003039:9:3:6 17 | S01003040:4:1:3 18 | S01003041:6:2:4 19 | S01003042:8:4:4 20 | S01003043:6:3:3 21 | S01003044:15:4:11 22 | S01003045:14:5:9 23 | S01003046:11:6:5 24 | S01003047:14:8:6 25 | S01003048:8:3:5 26 | S01003049:5:3:2 27 | S01003050:7:3:4 28 | S01003051:20:11:9 29 | S01003052:5:3:2 30 | S01003053:10:6:4 31 | S01003054:11:6:5 32 | S01003055:10:3:7 33 | S01003056:31:12:19 34 | S01003057:12:1:11 35 | S01003058:44:20:24 36 | S01003059:13:4:9 37 | S01003060:16:9:7 38 | S01003061:4:1:3 39 | S01003062:14:6:8 40 | S01003063:7:3:4 41 | S01003064:12:6:6 42 | S01003065:16:9:7 43 | S01003066:10:6:4 44 | S01003067:8:5:3 45 | S01003068:10:3:7 46 | S01003069:7:3:4 47 | S01003070:3:1:2 48 | S01003071:6:1:5 49 | S01003072:7:2:5 50 | S01003073:12:7:5 51 | S01003074:16:9:7 52 | S01003075:11:5:6 53 | S01003076:23:14:9 54 | S01003077:10:4:6 55 | S01003078:7:5:2 56 | S01003079:11:9:2 57 | S01003080:13:5:8 58 | S01003081:18:8:10 59 | S01003082:18:10:8 60 | S01003083:17:7:10 61 | S01003084:8:5:3 62 | S01003085:12:2:10 63 | S01003086:10:4:6 64 | S01003087:11:9:2 65 | S01003088:12:5:7 66 | S01003089:8:5:3 67 | S01003090:12:6:6 68 | S01003091:3:2:1 69 | S01003092:5:2:3 70 | S01003093:8:4:4 71 | S01003094:15:7:8 72 | S01003095:6:3:3 73 | S01003096:9:5:4 74 | S01003097:1:0:1 75 | S01003098:16:8:8 76 | S01003099:5:3:2 77 | S01003100:10:5:5 78 | S01003101:8:3:5 79 | S01003102:6:5:1 80 | S01003103:8:6:2 81 | S01003104:10:6:4 82 | S01003105:9:4:5 83 | S01003106:12:6:6 84 | S01003107:7:2:5 85 | S01003108:9:3:6 86 | S01003109:13:8:5 87 | S01003110:13:4:9 88 | S01003111:9:5:4 89 | S01003112:10:2:8 90 | S01003113:7:5:2 91 | S01003114:11:9:2 92 | S01003115:17:7:10 93 | S01003116:7:4:3 94 | S01003117:14:3:11 95 | S01003118:4:2:2 96 | S01003119:9:6:3 97 | S01003120:13:9:4 98 | S01003121:8:5:3 99 | S01003122:6:4:2 100 | S01003123:7:5:2 101 | S01003124:12:5:7 102 | S01003125:13:6:7 103 | S01003126:2:1:1 104 | S01003127:13:11:2 105 | S01003128:7:4:3 106 | S01003129:24:11:13 107 | S01003130:10:5:5 108 | S01003131:12:5:7 109 | S01003132:12:6:6 110 | S01003133:19:8:11 111 | S01003134:10:7:3 112 | S01003135:3:2:1 113 | S01003136:22:13:9 114 | S01003137:10:5:5 115 | S01003138:7:2:5 116 | S01003139:20:11:9 117 | S01003140:9:8:1 118 | S01003141:14:5:9 119 | S01003142:14:8:6 120 | S01003143:13:5:8 121 | S01003144:10:7:3 122 | S01003145:5:4:1 123 | S01003146:10:7:3 124 | S01003147:5:2:3 125 | S01003148:5:0:5 126 | S01003149:11:7:4 127 | S01003150:11:3:8 128 | S01003151:6:2:4 129 | S01003152:7:3:4 130 | S01003153:10:4:6 131 | S01003154:16:8:8 132 | S01003155:19:13:6 133 | S01003156:7:2:5 134 | S01003157:11:5:6 135 | S01003158:2:0:2 136 | S01003159:0:0:0 137 | S01003160:8:5:3 138 | S01003161:4:2:2 139 | S01003162:7:6:1 140 | S01003163:11:6:5 141 | S01003164:27:12:15 142 | S01003165:14:7:7 143 | S01003166:12:6:6 144 | S01003167:13:7:6 145 | S01003168:17:10:7 146 | S01003169:35:18:17 147 | S01003170:17:9:8 148 | S01003171:9:7:2 149 | S01003172:17:10:7 150 | S01003173:9:6:3 151 | S01003174:26:11:15 152 | S01003175:23:12:11 153 | S01003176:17:12:5 154 | S01003177:25:17:8 155 | S01003178:9:6:3 156 | S01003179:11:5:6 157 | S01003180:8:4:4 158 | S01003181:7:3:4 159 | S01003182:7:3:4 160 | S01003183:13:7:6 161 | S01003184:7:2:5 162 | S01003185:12:6:6 163 | S01003186:7:4:3 164 | S01003187:16:8:8 165 | S01003188:24:11:13 166 | S01003189:19:9:10 167 | S01003190:9:6:3 168 | S01003191:15:7:8 169 | S01003192:11:7:4 170 | S01003193:38:22:16 171 | S01003194:7:4:3 172 | S01003195:4:2:2 173 | S01003196:12:4:8 174 | S01003197:5:3:2 175 | S01003198:21:7:14 176 | S01003199:16:9:7 177 | S01003200:16:12:4 178 | S01003201:2:0:2 179 | S01003202:17:8:9 180 | S01003203:9:3:6 181 | S01003204:6:2:4 182 | S01003205:11:7:4 183 | S01003206:13:7:6 184 | S01003207:22:7:15 185 | S01003208:32:16:16 186 | S01003209:3:2:1 187 | S01003210:7:3:4 188 | S01003211:20:13:7 189 | S01003212:4:1:3 190 | S01003213:7:2:5 191 | S01003214:9:5:4 192 | S01003215:11:8:3 193 | S01003216:3:1:2 194 | S01003217:12:7:5 195 | S01003218:6:1:5 196 | S01003219:8:4:4 197 | S01003220:11:7:4 198 | S01003221:24:12:12 199 | S01003222:16:9:7 200 | S01003223:11:6:5 201 | S01003224:3:1:2 202 | S01003225:6:2:4 203 | S01003226:11:6:5 204 | S01003227:36:20:16 205 | S01003228:22:11:11 206 | S01003229:10:8:2 207 | S01003230:9:7:2 208 | S01003231:7:3:4 209 | S01003232:9:4:5 210 | S01003233:2:2:0 211 | S01003234:18:9:9 212 | S01003235:5:3:2 213 | S01003236:17:8:9 214 | S01003237:12:7:5 215 | S01003238:8:3:5 216 | S01003239:17:8:9 217 | S01003240:9:4:5 218 | S01003241:10:4:6 219 | S01003242:12:7:5 220 | S01003243:9:4:5 221 | S01003244:12:6:6 222 | S01003245:10:4:6 223 | S01003246:7:2:5 224 | S01003247:8:5:3 225 | S01003248:22:8:14 226 | S01003249:14:5:9 227 | S01003250:3:1:2 228 | S01003251:13:5:8 229 | S01003252:4:2:2 230 | S01003253:20:11:9 231 | S01003254:7:3:4 232 | S01003255:11:5:6 233 | S01003256:42:20:22 234 | S01003257:7:4:3 235 | S01003258:4:3:1 236 | S01003259:6:1:5 237 | S01003260:2:1:1 238 | S01003261:2:2:0 239 | S01003262:9:5:4 240 | S01003263:18:6:12 241 | S01003264:5:3:2 242 | S01003265:8:5:3 243 | S01003266:4:2:2 244 | S01003267:11:3:8 245 | S01003268:26:16:10 246 | S01003269:12:6:6 247 | S01003270:14:6:8 248 | S01003271:20:10:10 249 | S01003272:19:13:6 250 | S01003273:14:8:6 251 | S01003274:5:1:4 252 | S01003275:16:7:9 253 | S01003276:3:3:0 254 | S01003277:5:3:2 255 | S01003278:7:2:5 256 | S01003279:8:5:3 257 | S01003280:8:3:5 258 | S01003281:5:3:2 259 | S01003282:7:2:5 260 | S01003283:7:2:5 261 | S01003284:11:5:6 262 | S01003285:2:1:1 263 | S01003286:12:5:7 264 | S01003287:4:3:1 265 | S01003288:6:3:3 266 | S01003289:8:4:4 267 | S01003290:12:7:5 268 | S01003291:18:10:8 269 | S01003292:2:2:0 270 | S01003293:14:8:6 271 | S01003294:8:2:6 272 | S01003295:6:4:2 273 | S01003296:14:7:7 274 | S01003297:9:2:7 275 | S01003298:14:3:11 276 | S01003299:4:2:2 277 | S01003300:7:3:4 278 | S01003301:11:4:7 279 | S01003302:6:4:2 280 | S01003303:16:7:9 281 | S01003304:17:9:8 282 | S01003305:16:12:4 283 | S01003306:3:0:3 284 | S01003307:10:6:4 285 | S01003308:8:2:6 286 | S01003309:11:6:5 287 | S01003310:10:7:3 288 | S01003311:5:4:1 289 | S01003312:9:7:2 290 | S01003313:12:7:5 291 | S01003314:11:0:11 292 | S01003315:11:8:3 293 | S01003316:6:2:4 294 | S01003317:11:6:5 295 | S01003318:1:0:1 296 | S01003319:0:0:0 297 | S01003320:7:7:0 298 | S01003321:5:1:4 299 | S01003322:8:4:4 300 | S01003323:4:2:2 301 | S01003324:10:4:6 302 | S01003325:11:6:5 303 | S01003326:11:5:6 304 | S01003327:12:3:9 305 | S01003328:7:4:3 306 | S01003329:11:8:3 307 | S01003330:13:5:8 308 | S01003331:10:6:4 309 | S01003332:5:3:2 310 | S01003333:9:5:4 311 | S01003334:16:9:7 312 | S01003335:6:3:3 313 | S01003336:13:7:6 314 | S01003337:31:17:14 315 | S01003338:7:4:3 316 | S01003339:8:4:4 317 | S01003340:13:10:3 318 | S01003341:11:3:8 319 | S01003342:8:4:4 320 | S01003343:11:6:5 321 | S01003344:9:2:7 322 | S01003345:12:8:4 323 | S01003346:12:6:6 324 | S01003347:15:9:6 325 | S01003348:12:5:7 326 | S01003349:22:12:10 327 | S01003350:13:5:8 328 | S01003351:14:6:8 329 | S01003352:17:9:8 330 | S01003353:5:3:2 331 | S01003354:10:6:4 332 | S01003355:7:5:2 333 | S01003356:11:2:9 334 | S01003357:1:0:1 335 | S01003358:5:3:2 336 | S01003359:7:3:4 337 | S01003360:9:5:4 338 | S01003361:6:4:2 339 | S01003362:11:7:4 340 | S01003363:5:2:3 341 | S01003364:11:1:10 342 | S01003365:14:7:7 343 | S01003366:3:3:0 344 | S01003367:29:15:14 345 | S01003368:9:6:3 346 | S01003369:5:2:3 347 | S01003370:10:7:3 348 | S01003371:9:5:4 349 | S01003372:9:2:7 350 | S01003373:21:13:8 351 | S01003374:4:1:3 352 | S01003375:12:7:5 353 | S01003376:13:5:8 354 | S01003377:8:4:4 355 | S01003378:19:10:9 356 | S01003379:10:4:6 357 | S01003380:21:12:9 358 | S01003381:3:0:3 359 | S01003382:25:12:13 360 | S01003383:6:3:3 361 | S01003384:9:3:6 362 | S01003385:8:2:6 363 | S01003386:5:4:1 364 | S01003387:13:9:4 365 | S01003388:11:5:6 366 | S01003389:15:7:8 367 | S01003390:22:9:13 368 | S01003391:9:6:3 369 | S01003392:8:2:6 370 | S01003393:11:5:6 371 | S01003394:8:3:5 372 | S01003395:6:4:2 373 | S01003396:25:10:15 374 | S01003397:14:8:6 375 | S01003398:10:3:7 376 | S01003399:12:6:6 377 | S01003400:1:0:1 378 | S01003401:14:8:6 379 | S01003402:13:4:9 380 | S01003403:12:3:9 381 | S01003404:5:3:2 382 | S01003405:3:2:1 383 | S01003406:4:4:0 384 | S01003407:5:3:2 385 | S01003408:8:1:7 386 | S01003409:26:12:14 387 | S01003410:8:5:3 388 | S01003411:13:6:7 389 | S01003412:19:7:12 390 | S01003413:8:3:5 391 | S01003414:4:2:2 392 | S01003415:6:4:2 393 | S01003416:16:5:11 394 | S01003417:8:3:5 395 | S01003418:13:3:10 396 | S01003419:17:8:9 397 | S01003420:9:6:3 398 | S01003421:11:5:6 399 | S01003422:7:1:6 400 | S01003423:8:4:4 401 | S01003424:15:6:9 402 | S01003425:6:0:6 403 | S01003426:12:6:6 404 | S01003427:10:5:5 405 | S01003428:25:16:9 406 | S01003429:9:6:3 407 | S01003430:8:6:2 408 | S01003431:10:3:7 409 | S01003432:9:3:6 410 | S01003433:7:4:3 411 | S01003434:9:4:5 412 | S01003435:8:6:2 413 | S01003436:14:6:8 414 | S01003437:5:3:2 415 | S01003438:9:4:5 416 | S01003439:4:4:0 417 | S01003440:11:8:3 418 | S01003441:32:17:15 419 | S01003442:20:6:14 420 | S01003443:15:6:9 421 | S01003444:10:1:9 422 | S01003445:21:9:12 423 | S01003446:4:1:3 424 | S01003447:7:3:4 425 | S01003448:7:3:4 426 | S01003449:3:2:1 427 | S01003450:5:4:1 428 | S01003451:7:5:2 429 | S01003452:6:1:5 430 | S01003453:18:10:8 431 | S01003454:12:7:5 432 | S01003455:19:11:8 433 | S01003456:5:1:4 434 | S01003457:29:16:13 435 | S01003458:18:8:10 436 | S01003459:16:5:11 437 | S01003460:15:9:6 438 | S01003461:9:3:6 439 | S01003462:10:5:5 440 | S01003463:4:3:1 441 | S01003464:12:8:4 442 | S01003465:28:19:9 443 | S01003466:8:4:4 444 | S01003467:9:5:4 445 | S01003468:6:2:4 446 | S01003469:6:4:2 447 | S01003470:6:2:4 448 | S01003471:5:2:3 449 | S01003472:10:5:5 450 | S01003473:10:4:6 451 | S01003474:9:7:2 452 | S01003475:6:4:2 453 | S01003476:29:17:12 454 | S01003477:8:4:4 455 | S01003478:9:6:3 456 | S01003479:1:0:1 457 | S01003480:14:8:6 458 | S01003481:9:3:6 459 | S01003482:5:4:1 460 | S01003483:6:3:3 461 | S01003484:7:3:4 462 | S01003485:12:10:2 463 | S01003486:17:9:8 464 | S01003487:6:3:3 465 | S01003488:9:3:6 466 | S01003489:24:12:12 467 | S01003490:6:1:5 468 | S01003491:0:0:0 469 | S01003492:23:14:9 470 | S01003493:6:2:4 471 | S01003494:4:0:4 472 | S01003495:20:9:11 473 | S01003496:5:2:3 474 | S01003497:8:6:2 475 | S01003498:13:8:5 476 | S01003499:13:9:4 477 | S01003500:15:9:6 478 | S01003501:4:1:3 479 | S01003502:52:25:27 480 | S01003503:3:2:1 481 | S01003504:13:5:8 482 | S01003505:0:0:0 483 | S01003506:13:7:6 484 | S01003507:11:5:6 485 | S01003508:5:1:4 486 | S01003509:7:3:4 487 | S01003510:6:3:3 488 | S01003511:14:5:9 489 | S01003512:7:2:5 490 | S01003513:4:1:3 491 | S01003514:7:3:4 492 | S01003515:6:3:3 493 | S01003516:6:3:3 494 | S01003517:7:5:2 495 | S01003518:16:5:11 496 | S01003519:7:5:2 497 | S01003520:12:8:4 498 | S01003521:1:0:1 499 | S01003522:11:4:7 500 | S01003523:11:6:5 501 | S01003524:18:8:10 502 | S01003525:11:5:6 503 | S01003526:8:4:4 504 | S01003527:2:1:1 505 | S01003528:7:3:4 506 | S01003529:7:3:4 507 | S01003530:12:4:8 508 | S01003531:13:9:4 509 | S01003532:20:12:8 510 | S01003533:19:11:8 511 | S01003534:11:1:10 512 | S01003535:10:5:5 513 | S01003536:12:6:6 514 | S01003537:7:4:3 515 | S01003538:12:6:6 516 | S01003539:13:6:7 517 | S01003540:1:1:0 518 | S01003541:26:13:13 519 | S01003542:12:7:5 520 | S01003543:11:2:9 521 | S01003544:6:5:1 522 | S01003545:5:2:3 523 | S01003546:12:7:5 524 | S01003547:14:9:5 525 | S01003548:0:0:0 526 | S01003549:14:7:7 527 | S01003550:3:0:3 528 | S01003551:14:7:7 529 | S01003552:10:7:3 530 | S01003553:12:6:6 531 | S01003554:14:10:4 532 | S01003555:7:4:3 533 | S01003556:6:3:3 534 | S01003557:14:2:12 535 | S01003558:15:4:11 536 | S01003559:11:6:5 537 | S01003560:17:9:8 538 | S01003561:14:6:8 539 | S01003562:6:5:1 540 | S01003563:5:2:3 541 | S01003564:11:7:4 542 | S01003565:9:6:3 543 | S01003566:11:9:2 544 | S01003567:22:13:9 545 | S01003568:5:1:4 546 | S01003569:6:4:2 547 | S01003570:6:5:1 548 | S01003571:18:8:10 549 | S01003572:18:10:8 550 | S01003573:8:3:5 551 | S01003574:13:8:5 552 | S01003575:14:6:8 553 | S01003576:7:5:2 554 | S01003577:10:7:3 555 | S01003578:1:1:0 556 | S01003579:8:4:4 557 | S01003580:25:15:10 558 | S01003581:28:11:17 559 | S01003582:17:6:11 560 | S01003583:7:3:4 561 | S01003584:10:3:7 562 | S01003585:9:3:6 563 | S01003586:19:13:6 564 | S01003587:6:1:5 565 | S01003588:5:1:4 566 | S01003589:12:9:3 567 | S01003590:14:10:4 568 | S01003591:14:10:4 569 | S01003592:22:10:12 570 | S01003593:10:5:5 571 | S01003594:7:6:1 572 | S01003595:13:8:5 573 | S01003596:8:5:3 574 | S01003597:5:2:3 575 | S01003598:5:2:3 576 | S01003599:10:7:3 577 | S01003600:8:3:5 578 | S01003601:19:11:8 579 | S01003602:7:5:2 580 | S01003603:15:14:1 581 | S01003604:9:3:6 582 | S01003605:14:9:5 583 | S01003606:8:5:3 584 | S01003607:4:3:1 585 | S01003608:4:1:3 586 | S01003609:13:7:6 587 | S01003610:16:9:7 588 | S01003611:5:2:3 589 | S01003612:7:5:2 590 | S01003613:23:10:13 591 | S01003614:11:8:3 592 | S01003615:16:10:6 593 | S01003616:5:4:1 594 | S01003617:12:4:8 595 | S01003618:8:2:6 596 | S01003619:16:4:12 597 | S01003620:13:7:6 598 | S01003621:12:8:4 599 | S01003622:9:4:5 600 | S01003623:8:4:4 601 | S01003624:16:9:7 602 | S01003625:8:3:5 603 | S01003626:11:4:7 604 | S01003627:9:5:4 605 | S01003628:4:1:3 606 | S01003629:4:2:2 607 | S01003630:11:4:7 608 | S01003631:11:3:8 609 | S01003632:9:6:3 610 | S01003633:16:10:6 611 | S01003634:8:4:4 612 | S01003635:1:1:0 613 | S01003636:6:4:2 614 | S01003637:10:5:5 615 | S01003638:8:4:4 616 | S01003639:8:4:4 617 | S01003640:15:8:7 618 | S01003641:9:5:4 619 | S01003642:9:7:2 620 | S01003643:9:6:3 621 | S01003644:12:3:9 622 | S01003645:5:3:2 623 | S01003646:17:9:8 624 | S01003647:12:7:5 625 | S01003648:6:4:2 626 | S01003649:9:4:5 627 | S01003650:6:5:1 628 | S01003651:10:5:5 629 | S01003652:9:4:5 630 | S01003653:8:6:2 631 | S01003654:15:6:9 632 | S01003655:3:2:1 633 | S01003656:8:5:3 634 | S01003657:7:3:4 635 | S01003658:9:1:8 636 | S01003659:4:1:3 637 | S01003660:13:5:8 638 | S01003661:16:4:12 639 | S01003662:3:3:0 640 | S01003663:6:5:1 641 | S01003664:5:3:2 642 | S01003665:12:3:9 643 | S01003666:11:3:8 644 | S01003667:10:8:2 645 | S01003668:5:2:3 646 | S01003669:16:5:11 647 | S01003670:15:8:7 648 | S01003671:9:4:5 649 | S01003672:18:9:9 650 | S01003673:6:5:1 651 | S01003674:6:3:3 652 | S01003675:8:4:4 653 | S01003676:25:8:17 654 | S01003677:6:3:3 655 | S01003678:5:2:3 656 | S01003679:17:8:9 657 | S01003680:8:3:5 658 | S01003681:5:3:2 659 | S01003682:11:7:4 660 | S01003683:6:4:2 661 | S01003684:4:1:3 662 | S01003685:2:0:2 663 | S01003686:10:4:6 664 | S01003687:13:7:6 665 | S01003688:6:3:3 666 | S01003689:8:1:7 667 | S01003690:12:11:1 668 | S01003691:12:6:6 669 | S01003692:6:3:3 670 | S01003693:6:2:4 671 | S01003694:10:6:4 672 | S01003695:21:9:12 673 | S01003696:17:8:9 674 | S01003697:2:0:2 675 | S01003698:5:3:2 676 | S01003699:8:4:4 677 | S01003700:11:6:5 678 | S01003701:18:9:9 679 | S01003702:16:7:9 680 | S01003703:11:7:4 681 | S01003704:9:4:5 682 | S01003705:10:5:5 683 | S01003706:12:5:7 684 | S01003707:16:6:10 685 | S01003708:22:9:13 686 | S01003709:22:15:7 687 | S01003710:19:9:10 688 | S01003711:20:8:12 689 | S01003712:18:7:11 690 | S01003713:9:6:3 691 | S01003714:7:5:2 692 | S01003715:12:4:8 693 | S01003716:10:5:5 694 | S01003717:8:3:5 695 | S01003718:7:2:5 696 | -------------------------------------------------------------------------------- /lectures/Lec10.hs: -------------------------------------------------------------------------------- 1 | module Lec10 where 2 | 3 | {- LECTURE 10 : BUILDING PURE EVALUATORS 4 | 5 | In this lecture, we will look at how to build evaluators 6 | (a.k.a. interpreters) for a sequence of languages with various 7 | kinds of 'impure' features. The point of this isn't to (just) see 8 | how to implement simple programming languages in Haskell, but to 9 | get an insight into how to program with "non functional" features 10 | in a language like Haskell. -} 11 | 12 | {- PART I : EVALUATION -} 13 | 14 | data Expr 15 | = Number Int 16 | | Add Expr Expr 17 | deriving Show 18 | 19 | {- 'Expr's are binary trees, with 'Int's at the leaves and every node 20 | labeled with 'Add'. Here is an example 'Expr': -} 21 | 22 | myExpr :: Expr 23 | myExpr = Number 23 `Add` (Number 34 `Add` Number 56) 24 | 25 | {- representing the expression: 26 | 27 | 23 + (34 + 56) 28 | 29 | Note that the bracketing is important. Even though we know that it 30 | does not matter what order we bracket actual addition, we are not 31 | doing actual addition yet. 'Expr' is a type of _abstract_ syntax 32 | trees for expressions. To interpret an 'Expr' using actual 33 | arithmetic, we have to describe what to do for each constructor in 34 | 'Expr'. 35 | 36 | The 'evaluate' function defined here uses pattern matching to 37 | interpret each constructor in an 'Expr' with its "meaning". We make 38 | the decision that the meaning of 'Number n' is just 'n'. The 39 | meaning of 'Add' is the actual '+' function -- matching our 40 | intuition about how to interpret addition. -} 41 | 42 | evaluate :: Expr -> Int 43 | evaluate (Number n) = n 44 | evaluate (Add e1 e2) = evaluate e1 + evaluate e2 45 | 46 | {- Let's try it out: 47 | 48 | λ> evaluate myExpr 49 | 113 50 | 51 | We've written a small programming langauge! -} 52 | 53 | 54 | {- PART II : EVALUATION WITH EXCEPTIONS 55 | 56 | The 'Expr' type above described "pure" arithmetic expressions that 57 | always evaluate to a value. Often programming languages have 58 | facilities that allow for "non-pure" side effects to happen during 59 | the program. 60 | 61 | The following data type 'Expr2' extends 'Expr' with two new 62 | constructors: 'Throw2' and 'Catch2'. The intention is that 'Throw2' 63 | represents the action of throwing an exception, and 'Catch2' 64 | represents a try-catch style exception handler. The first argument 65 | to 'Catch2' is the expression to try, and the second argument is 66 | the exception handler. -} 67 | 68 | data Expr2 69 | = Number2 Int 70 | | Add2 Expr2 Expr2 71 | | Throw2 72 | | Catch2 Expr2 Expr2 73 | deriving Show 74 | 75 | {- An example program using Throw2 and Catch2 is this one: -} 76 | 77 | myProblemProgram :: Expr2 78 | myProblemProgram = 79 | (Number2 23 `Add2` (Number2 34 `Add2` Throw2)) `Catch2` (Number2 0) 80 | 81 | {- This program attempts to perform the same computation as before, but 82 | one of the numbers is faulty, so it throws an exception which is 83 | caught by an exception handler which handles it with a handler that 84 | always returns '0'. 85 | 86 | To define an evaluator for 'Expr2's, we might start by trying to 87 | write a function of type: 88 | 89 | evaluate2 :: Expr2 -> Int 90 | 91 | After all, evaluation of Expr2 should still result in integers 92 | being returned. However, this type does not model the fact that 93 | evaluation of an 'Expr2' may fail with an exception. We need to 94 | adjust the type of the return value of 'evalExpr2' to account for 95 | the possibility of throwing an exception. We do this by stating 96 | that evaluation returns 'Maybe Int' -- so it can either be 97 | 'Nothing' (when an exception is thrown), or 'Just n' (when 98 | evaluation returns normally). -} 99 | 100 | evaluate2 :: Expr2 -> Maybe Int 101 | {- For the 'Number2' case, we always return 'Just n', because there is 102 | no way to throw an exception while evaluating a number. -} 103 | evaluate2 (Number2 n) = Just n 104 | {- For the 'Add2' case, we have to evaluate 'e1' and 'e2', but we also 105 | have to deal with the possibility that evaluating either of them 106 | may cause an exception to be thrown, which we should propagate to 107 | the final answer. We do this by using a cascade of 'case's: -} 108 | evaluate2 (Add2 e1 e2) = case evaluate2 e1 of 109 | Nothing -> Nothing 110 | Just n1 -> case evaluate2 e2 of 111 | Nothing -> Nothing 112 | Just n2 -> Just (n1+n2) 113 | {- To interpret 'Throw2', we use 'Nothing' to represent the case when an 114 | exception is thrown. -} 115 | evaluate2 Throw2 = Nothing 116 | {- Finally, for the 'Catch2' case, we evaluate the first expression. If 117 | it returns a value, we just return that value. If it fails with 118 | 'Nothing', then we evaluate the exception handler and use its 119 | result as the result of evaluating the whole 'Catch2' expression. -} 120 | evaluate2 (Catch2 e1 e2) = case evaluate2 e1 of 121 | Nothing -> evaluate2 e2 122 | Just n -> Just n 123 | 124 | {- Now evaluating our test program shows the exception throwing and 125 | handling working: 126 | 127 | λ> evaluate2 myProblemProgram 128 | Just 0 129 | 130 | If we try to evaluate a program that throws an exception with no 131 | exception handler, then we get back 'Nothing': 132 | 133 | λ> evaluate2 (Number2 12 `Add2` Throw2) 134 | Nothing 135 | -} 136 | 137 | -- maybeApply (Just (+)) :: Maybe Int -> Maybe (Int -> Int) 138 | 139 | maybeApply :: Maybe (a -> b) -> Maybe a -> Maybe b 140 | maybeApply (Just f) (Just a) = Just (f a) 141 | maybeApply Nothing _ = Nothing 142 | maybeApply _ Nothing = Nothing 143 | 144 | maybePure :: a -> Maybe a 145 | maybePure a = Just a 146 | 147 | 148 | {- PART III : EVALUATION WITH PRINTING 149 | 150 | Exceptions are a kind of "side-effect" that can happen when we try 151 | to evaluate an expression. Another possible side effect we might 152 | have during execution of a program is the printing of logging 153 | messages. We now extend the 'Expr' type in a different way to 154 | include the possibility of printing by adding a constructor 'Print 155 | message e'. The intended meaning is that this prints the message 156 | 'message' and then executes 'e'. -} 157 | 158 | data Expr3 159 | = Number3 Int 160 | | Add3 Expr3 Expr3 161 | | Print3 String Expr3 162 | deriving Show 163 | 164 | {- An example program using this new feature is the following, which 165 | intersperses some arithmetic with instructions to print out some 166 | messages: -} 167 | 168 | printingProg :: Expr3 169 | printingProg = 170 | (Print3 "Hello" (Number3 23)) 171 | `Add3` 172 | (Number3 34 `Add3` (Print3 " World" (Number3 56))) 173 | 174 | {- To evaluate expressions with printing, we keep a log of all the 175 | messages that are printed, in order. We represent this log using a 176 | list. Therefore, the result type of our evaluator is a pair of the 177 | string printed, and the resulting integer: -} 178 | evaluate3 :: Expr3 -> (String, Int) 179 | {- Evaluating a number 'n' results in the empty message being printed, 180 | and the number 'n' as the final answer. -} 181 | evaluate3 (Number3 n) = ("", n) 182 | {- Evaluating 'Add3 e1 e2' means we must evaluate 'e1', getting the 183 | output during that evaluation and its integer value, then we 184 | evaluate 'e2' getting the second output and its integer 185 | value. Finally, we combine the outputs (using '++') and the 186 | integers (using '+'). We use a 'where' clause to name the 187 | intermediate results arising from evaluating 'e1' and 'e2'. -} 188 | evaluate3 (Add3 e1 e2) = (s1 ++ s2, n1 + n2) 189 | where (s1, n1) = evaluate3 e1 190 | (s2, n2) = evaluate3 e2 191 | {- Evaluating 'Print3' is where we actually add messages to the output 192 | -- if we didn't have Print then the only output you can build from 193 | the empty string and append is the empty string! Printing evaluates 194 | its second argument to get its result and list of messages, and 195 | then prepends the new message to the log: -} 196 | evaluate3 (Print3 s e) = (s ++ s1, n) 197 | where (s1, n) = evaluate3 e 198 | 199 | {- Evaluating our test program gives us the messages and result we expect: 200 | 201 | λ> evaluate3 printingProg 202 | ("Hello World",113) 203 | -} 204 | 205 | 206 | printApply :: (String, a -> b) -> (String, a) -> (String, b) 207 | printApply (s1, f) (s2, a) = (s1 ++ s2, f a) 208 | 209 | printPure :: a -> (String,a) 210 | printPure a = ("",a) 211 | 212 | {- 213 | class Functor f => Applicative f where 214 | pure :: a -> f a 215 | (<*>) :: f (a -> b) -> f a -> f b 216 | -} 217 | 218 | -- fmap :: (a -> b) -> f a -> f b 219 | -- (<*>) :: f (a -> b) -> f a -> f b 220 | 221 | evaluateApp :: Applicative f => Expr -> f Int 222 | evaluateApp (Number n) = pure n 223 | evaluateApp (Add e1 e2) = pure (+) <*> evaluateApp e1 <*> evaluateApp e2 224 | 225 | 226 | {- PART IV : EVALUATION WITH CHOICE 227 | 228 | A final side effect we will look at here is non-determinism. To the 229 | original 'Expr' data type, we add 'Choice' which takes two 230 | arguments and somehow makes a choice between them. There are 231 | several different reasonable interpretations of Choice, and we will 232 | look at two of them. -} 233 | 234 | data Expr4 235 | = Number4 Int 236 | | Add4 Expr4 Expr4 237 | | Choice Expr4 Expr4 238 | deriving Show 239 | 240 | -- if (*) { 241 | -- STATEMENT 1; 242 | -- } else { 243 | -- STATEMENT 2; 244 | -- } 245 | 246 | {- Here is an example program that uses 'Choice'. It adds two numbers 247 | together, but one of those numbers is not fully determined: it 248 | could either be '0' or '1'. -} 249 | 250 | myDitheringProgram :: Expr4 251 | myDitheringProgram = 252 | ((Number4 0) `Choice` (Number4 1)) `Add4` (Number4 2) 253 | 254 | {- Here is a slightly more complex program using 'Choice'. There are now 255 | two sources of non-determinism within the expression. -} 256 | 257 | myDitheringProgram2 :: Expr4 258 | myDitheringProgram2 = 259 | ((Number4 23 `Choice` Number4 32) 260 | `Add4` 261 | ((Number4 34 `Add4` Number4 56) 262 | `Choice` 263 | (Number4 23 `Add4` Number4 34))) 264 | 265 | -- (23 || 32) + ((34 + 56) || (23 +34)) 266 | 267 | {- A first attempt at writing an evaluator for expressions with choice 268 | might have type: 269 | 270 | evaluate4 :: Expr4 -> Int 271 | 272 | However, we get stuck when trying to evaluate (Choice e1 e2): 273 | 274 | evaluate4 (Choice e1 e2) = ??? 275 | 276 | We must return a single integer, but we have a choice of two 277 | expressions to evaluate to get integers! There are several ways out 278 | of this situation: 279 | 280 | 1. We could evaluate both 'e1' and 'e2' and combine their answers 281 | somehow -- taking their sum, or maximum, or something. This 282 | seems intuitively to not be faithful to the notion of 283 | 'Choice'. 284 | 285 | 2. We could always take 'e1' or always take 'e2'. So we build a 286 | 'biased' interpreter that always makes choices for us. This is 287 | reasonable, but we could be more general. 288 | 289 | 3. We could return all possible choices, perhaps as a list. 290 | 291 | 4. We could assume that we are given a supply of booleans that 292 | tells us how to resolve each choice in turn. 293 | 294 | Options 3 and 4 seem reasonable and interesting, so let's implement 295 | them. 296 | 297 | We implement Option 3 by writing a function of the following type: -} 298 | evaluate4opt3 :: Expr4 -> [Int] 299 | {- Evaluating a single number has only one possibility, so we return it 300 | in a list with one element: -} 301 | evaluate4opt3 (Number4 n) = [n] 302 | {- To evaluate an 'Add', we collect all the possibilities for evaluating 303 | the two sub-expressions, and then compute all the possible ways of 304 | adding them together, using a list comprehension. -} 305 | evaluate4opt3 (Add4 e1 e2) = [ n1 + n2 | n1 <- ns1, n2 <- ns2 ] 306 | where ns1 = evaluate4opt3 e1 307 | ns2 = evaluate4opt3 e2 308 | {- Evaluation of 'Choice' also collects all the possibilities for 309 | evaluating its sub-expressions, but then combines them using '++', 310 | so that we collect all the possible outcomes. -} 311 | evaluate4opt3 (Choice e1 e2) = ns1 ++ ns2 312 | where ns1 = evaluate4opt3 e1 313 | ns2 = evaluate4opt3 e2 314 | 315 | {- Evaluating 'myDitheringProgram' with 'evalExpr4opt4' now gives us all 316 | the possible results: 317 | 318 | λ> evaluate4opt3 myDitheringProgram 319 | [2,3] 320 | 321 | Also for 'myDitheringProgram2', which gives four results arising 322 | from all combinations of the two choices: 323 | 324 | λ> evaluate4opt3 myDitheringProgram2 325 | [113,80,122,89] 326 | -} 327 | 328 | {- We implement Option 4 by writing a function of the following type: -} 329 | evaluate4opt4 :: Expr4 -> [Bool] -> (Int, [Bool]) 330 | {- After we take an Expr4, we take a list of 'Bool's that will tell us 331 | how to resolve each choice in turn. We then return the integer 332 | values resulting from evaluating the expression with those choices, 333 | and the left-over list of choices. 334 | 335 | Evaluating a "pure" number results in just that number, and the 336 | list of choices is passed through unaffected: -} 337 | evaluate4opt4 (Number4 n) choices = 338 | (n, choices) 339 | {- Evaluating an addition means that we have to evaluate both 340 | sub-expressions, but we must be careful to "thread through" the 341 | list of choices: we evaluate 'e1' with the initial list, getting 342 | 'choices1', which we use to evaluate 'e2', to get 'choices2', which 343 | we return. -} 344 | evaluate4opt4 (Add4 e1 e2) choices = (n1 + n2, choices2) 345 | where (n1, choices1) = evaluate4opt4 e1 choices 346 | (n2, choices2) = evaluate4opt4 e2 choices1 347 | {- Finally, evaluating 'Choice e1 e2' uses one of the choices from the 348 | list. For simplicity, we assume that we are given enough 349 | pre-determined choices to evaluate all the 'Choice's in the 350 | expression, so we don't handle the case with the empty list. -} 351 | evaluate4opt4 (Choice e1 e2) (c:choices) = 352 | evaluate4opt4 (if c then e1 else e2) choices 353 | 354 | {- NOTE: Notice the similarity between 'evaluate4opt3' and the 'process' 355 | function from Ex2! -} 356 | 357 | {- Evaluating 'myDitheringProgram' with a list of predetermined choices 358 | yields a single value, and the left-over choices: 359 | 360 | λ> evaluate4opt4 myDitheringProgram [True, True] 361 | (2,[True]) 362 | λ> evaluate4opt4 myDitheringProgram [False, True] 363 | (3,[True]) 364 | 365 | Evaluating 'myDitheringProgram2' with the same lists consumes all 366 | the input, due to the presence of two choices in the program: 367 | 368 | λ> evaluate4opt4 myDitheringProgram2 [True, True] 369 | (113,[]) 370 | λ> evaluate4opt4 myDitheringProgram2 [False, True] 371 | (122,[]) 372 | -} 373 | 374 | {- EXERCISE: Implement Option 2. -} 375 | 376 | {- EXERCISE: The following Expr5 type also adds the possibilty of 377 | 'Failure' as well as choice. Write extended version of 'evalExpr4' 378 | and 'evalExpr4opt4' for this new type that also interpret 379 | Failure. You will have to change the type of 'evalExpr4'. -} 380 | 381 | data Expr5 382 | = Number5 Int 383 | | Add5 Expr5 Expr5 384 | | Choice5 Expr5 Expr5 385 | | Failure5 386 | deriving Show 387 | -------------------------------------------------------------------------------- /lectures/Lec05.hs: -------------------------------------------------------------------------------- 1 | module Lec05 where 2 | 3 | import Prelude hiding (map, filter, (.)) 4 | 5 | {- LECTURE 05 : HIGHER ORDER FUNCTIONS 6 | 7 | In this lecture, we talked about the concept of functions as 8 | values, and how this can be used to turn programs that solve one 9 | specific problem into more general programs that solve whole 10 | classes of problems. 11 | 12 | Haskell programs can pass values like integers and strings to and 13 | from functions, and store them in structures like lists and 14 | trees. Haskell treats functions no differently from any other kind 15 | of data: functions can be returned as the result of functions, 16 | passed into functions, and stored in data structures. 17 | 18 | First, we will look at how functions can return functions as 19 | results. -} 20 | 21 | {- PART I : FUNCTIONS THAT RETURN FUNCTIONS 22 | 23 | We've already seen many functions that take several arguments. An 24 | example is 'add', which adds two 'Int's and returns an 'Int': -} 25 | 26 | add :: Int -> Int -> Int 27 | add x y = x + y 28 | 29 | {- We write the type of a function that takes two arguments like so: 30 | 31 | t1 -> t2 -> t3 32 | 33 | What we've not mentioned so far is that this is really shorthand 34 | notation for the following type with parentheses inserted: 35 | 36 | t1 -> (t2 -> t3) 37 | 38 | Remembering that 'a -> b' is the type of functions that take 'a's 39 | and return 'b's, we can read this type as the type of "functions 40 | that take 't1's and return functions that take 't2's and return 41 | 't3's. 42 | 43 | Therefore, the add function "takes an 'Int' and returns a function 44 | that takes an(other) 'Int' and returns an 'Int'. 45 | 46 | Once we see that 'add' is really a function that returns a 47 | function, we can see that we needn't always give it two 48 | arguments. We can define the 'addTen' functions by only giving 49 | 'add' one of its arguments: -} 50 | 51 | addTen :: Int -> Int 52 | addTen = add 10 53 | 54 | {- 'addTen' has type 'Int -> Int', even though we didn't write an 55 | argument name on the left side of the '='s, because 'add' has type 56 | 'Int -> (Int -> Int)' and we've given an 'Int', leaving 'Int -> 57 | Int'. We could also write 'addTen' giving an explicit name for the 58 | argument, which we pass on to 'add 10'. This gives 'addTen2', which 59 | is equivalent to 'addTen': -} 60 | 61 | addTen2 :: Int -> Int 62 | addTen2 x = add 10 x 63 | 64 | {- We can see even more clearly that multi-argument functions in Haskell 65 | work by taking one argument and returning a function by writing out 66 | a definition of 'add' using the '\x -> E' notation for 67 | functions. (The backslash '\' is meant to be an ASCII 68 | representation of a Greek lambda, because 'lambda' is a commonly 69 | used mathematical notation for writing anonymous functions.) An 70 | expression of the form '\x -> E' stands for "a function that takes 71 | an argument, which we call 'x', and returns 'E'". We write out 72 | 'add' in this form like so: -} 73 | 74 | add2 :: Int -> (Int -> Int) 75 | add2 = \x -> (\y -> x + y) 76 | 77 | {- (Look at the way the bracketing in the program matches the bracketing 78 | in the type!) 79 | 80 | As a shorthand, we can avoid writing things like "\x -> (\y -> (\z -> 81 | ..." and instead write all the argument names together before the 82 | "->": -} 83 | 84 | add3 :: Int -> (Int -> Int) 85 | add3 = \x y -> x + y 86 | 87 | {- The `\`/lambda notation also accepts patterns as well as argument 88 | names, as long as there is only one pattern. For example, pattern 89 | matching against pairs: -} 90 | 91 | fst2 :: (a,b) -> a 92 | fst2 = \(a,b) -> a 93 | 94 | {- (Look at the coincidence between the type and the program!) 95 | 96 | The '\'/lambda notation for functions may seem a bit pointless so 97 | far. Everything we've written using this notation could have been 98 | written more simply by placing the argument names to the left of 99 | the '='s. The advantage of the '\'/lambda notation is that it 100 | allows us to write functions without needing to give them 101 | names. We'll see why this is important after we look at functions 102 | that take other functions as input. -} 103 | 104 | 105 | {- PART II : FUNCTIONS THAT TAKE FUNCTIONS AS INPUT 106 | 107 | As I said in the introduction, Haskell treats functions as it does 108 | any other kind of value. The can be returned by functions, as we 109 | saw in Part I. We'll now look at how and why Haskell functions can 110 | take functions as arguments. 111 | 112 | Let's start by looking at a simple definition. Here is a definition 113 | of the number 'ten' by adding '5' to itself: -} 114 | 115 | ten :: Int 116 | ten = add 5 5 117 | 118 | {- We now think to ourselves "there's nothing special about the number 119 | '5' here, we could be adding any number to itself". So we move 120 | from the specific '5' to a general 'x', which we make an argument 121 | of the function. We now have a function that takes an 'Int' and 122 | returns an 'Int': -} 123 | 124 | double :: Int -> Int 125 | double x = add x x 126 | 127 | {- Continuing this line of thought, we think to ourselves "there's 128 | nothing special about 'add'ing here, we could use any operation 129 | that takes two 'Int's and returns an 'Int'". So we move from the 130 | specific 'add' to a general 'f', which we make an argument of the 131 | function. We adjust the type again: 'add' has type 'Int -> Int -> 132 | Int', so our new function takes a value of this type and returns a 133 | function that takes 'Int's and returns 'Int's: -} 134 | 135 | applyCopy :: (Int -> Int -> Int) -> Int -> Int 136 | applyCopy f x = f x x 137 | 138 | {- 'applyCopy' is now a generally applicable function that takes /any/ 139 | two argument function on 'Int's, and /any/ 'Int' and passes that 140 | 'Int' twice to the given function. 141 | 142 | We call 'applyOrder' a *higher order* function because it takes a 143 | function as its argument. The order of a function refers to how 144 | 'functiony' its arguments are: A value with no arguments is of 145 | order 0, a function with arguments that have no arguments is order 146 | 1, a function with arguments that take arguments is order 2, and so 147 | on. 148 | 149 | Because we have constructed 'applyCopy' by repeated moves from the 150 | specific to the general, we can get back down to earth again by 151 | applying 'applyCopy' to the original specific 'add' and '5'. So we 152 | can recover the 'double' function by applying 'applyCopy' to 'add': -} 153 | 154 | double2 :: Int -> Int 155 | double2 = applyCopy add 156 | 157 | {- And we can recover 'ten' by applying 'double2' to '5': -} 158 | 159 | ten2 :: Int 160 | ten2 = double2 5 161 | 162 | {- When we moved from 'ten' to 'applyCopy' above, we didn't change the 163 | types much: in the end, 'applyCopy' still worked on 'Int's. In the 164 | example, we will see how moving from specific functions to more 165 | general ones allows us to also make the types more general too. 166 | 167 | The 'quadruple' function applies 'double' twice to double a number: -} 168 | 169 | quadruple :: Int -> Int 170 | quadruple x = double (double x) 171 | 172 | {- As above, there is nothing special about 'double' here. We move from 173 | the specific 'double' to a general 'f' to make the 'twice' 174 | function, which applies a function to an argument, and then applies 175 | it again. Only this time, we also make the type more general -- 176 | there is nothing specific to 'Int's in the definition of 'twice' so 177 | we can replace the specific 'Int' by the general 'a': -} 178 | 179 | twice :: (a -> a) -> a -> a 180 | twice f x = f (f x) 181 | 182 | {- EXERCISE: what is the more general type for 'applyCopy' above? 183 | 184 | We needn't always work out the more general type for ourselves. We 185 | can ask GHCi to do it for us: 186 | 187 | Prelude> :t twice 188 | (t -> t) -> t -> t 189 | 190 | As with 'applyCopy' above, we can recover 'quadruple' by applying 191 | twice to 'double', or any other way of writing 'double' that we can 192 | think of. This is where the anonymous '\'/lambda notation comes in 193 | very useful for writing short functions that are only mentioned 194 | once without needing to think of a name. We can write 'double' as 195 | '\x -> x + x', which in some contexts may be clearer than the word 196 | 'double'. -} 197 | 198 | quadruple2 :: Int -> Int 199 | quadruple2 = twice (applyCopy add) 200 | -- twice double 201 | -- twice (\x -> x + x) 202 | -- twice (\x -> 2 * x) 203 | 204 | {- Because 'twice' is more general than 'quadruple', we can use it again 205 | for new purposes. For example, octupling:-} 206 | 207 | octtuple :: Int -> Int 208 | octtuple = twice quadruple 209 | 210 | {- FIXME: another example of twice. -} 211 | 212 | {- One of the most useful places to use higher-order functions is to 213 | make general functions for processing containers full of 214 | data. Here, we will concentrate on lists. Let's see how to make some 215 | reusable functions on lists by following the same 216 | specific-to-general methodology that we did above. 217 | 218 | Here is a function that doubles every element of a list of 219 | integers: -} 220 | 221 | doubleAll :: [Int] -> [Int] 222 | doubleAll [] = [] 223 | doubleAll (x:xs) = double x : doubleAll xs 224 | 225 | {- As above, we not that there is nothing special about use of the 226 | 'double' function here. So we can move from the specific 'double' 227 | to the general 'f'. This gives us a general function that applies 228 | 'f' to every element of a list, giving a new list of transformed 229 | elements. The name 'map' is the traditional name for this function: -} 230 | 231 | map :: (a -> b) -> [a] -> [b] 232 | map f [] = [] 233 | map f (x:xs) = f x : map f xs 234 | 235 | {- We get back to 'doubleAll' by applying 'map' to 'double': -} 236 | 237 | doubleAll2 :: [Int] -> [Int] 238 | doubleAll2 = map double 239 | 240 | {- 'map' allows us to "lift" any function acting on things to a function 241 | acting on lists of those things. For instance, taking the first 242 | value of a list of pairs by mapping 'fst' across the list: -} 243 | 244 | fsts :: [(a,b)] -> [a] 245 | fsts = map fst 246 | 247 | {- Or pairing strings with their lengths: -} 248 | 249 | withLengths :: [String] -> [(String, Int)] 250 | withLengths = map (\s -> (s, length s)) 251 | 252 | {- Another useful higher-order function on lists is 'filter'. This 253 | function filters the input list to only keep the elements that 254 | match some condition. The condition is provided as a function of 255 | type 'a -> Bool', where 'a' is the type of elements of the 256 | list. Instead of working from specific-to-general as we did above 257 | we give the function 'filter' directly: -} 258 | 259 | filter :: (a -> Bool) -> [a] -> [a] 260 | filter p [] = [] 261 | filter p (x:xs) 262 | | p x = x : filter p xs 263 | | otherwise = filter p xs 264 | 265 | {- Now we can use 'filter' to quickly write a function that only keeps 266 | the even numbers in a list. -} 267 | 268 | onlyEvens :: [Int] -> [Int] 269 | onlyEvens = filter (\x -> x `mod` 2 == 0) 270 | 271 | {- The functions 'map' and 'filter' are a useful pair of tools for 272 | building functions that work on lists, without having to write 273 | similar looking code over and over again. 274 | 275 | Now that we have reusable functions for transforming lists, we need 276 | a way to plug them together. We do this by 'composing' two 277 | functions using the 'compose' function: -} 278 | 279 | compose :: (b -> c) -> (a -> b) -> a -> c 280 | compose f g x = f (g x) 281 | 282 | {- 'compose' is so useful that the Haskell standard library calls it 283 | '.', and it is written infix (i.e., between its arguments. The '.' 284 | is meant to mimic in ASCII the mathematical circle notation for 285 | function composition. 286 | 287 | Here is a definition of '.', written using the '\'/lambda notation: -} 288 | 289 | (.) :: (b -> c) -> (a -> b) -> a -> c 290 | f . g = \x -> f (g x) 291 | 292 | {- Function composition is especially useful for creating 'pipelines' 293 | that plug together several basic functions for processing lists 294 | into a larger list processing function. The concept is similar to 295 | the idea of Unix pipelines that plug together small programs that 296 | do one thing into larger units. 297 | 298 | An example Unix pipeline is the following. The 'grep' ("global 299 | regular expression") program searches for lines that match some 300 | pattern (here "CS316"), and the 'cut' program extracts certain 301 | fields from each line (here "-f1" indicates that we want the first 302 | field). 303 | 304 | grep CS316 registered-students.txt | cut -f1 305 | 306 | In Haskell, we replace 'grep' with 'filter', and 'cut' with 'map 307 | fst' to get the following, where we've used function composition 308 | '(.)' to plug together the basic functions. Note that Haskell 309 | pipelines go right to left, unlike Unix pipelines, which go left 310 | to right. -} 311 | 312 | pipeline :: [(String,Int)] -> [String] 313 | pipeline = map fst . filter (\(s,i) -> s == "CS316") 314 | 315 | {- Another example uses 'wc -l' to count the number of lines in the 316 | output of 'grep': 317 | 318 | grep CS316 registered-students.txt | wc -l 319 | 320 | We can mimic this by using 'length': -} 321 | 322 | pipeline2 :: [(String,Int)] -> Int 323 | pipeline2 = length . filter (\(s,i) -> s == "CS316") 324 | 325 | {- An example of a longer pipeline is the following, which selects every 326 | other element from a list: -} 327 | 328 | everyOther :: [a] -> [a] 329 | everyOther = map snd . filter (\ (i,x) -> i `mod` 2 == 1) . zip [0..] 330 | 331 | {- How does this work? Let's break it down: 332 | 333 | 1. First, we pair every element in the input list with its index 334 | by zipping with the infinite list [0..] (remember how we did 335 | this in Lecture 03) 336 | 337 | 2. Then we filter to get only the element of the list with odd 338 | index. 339 | 340 | 3. Then we map 'snd' over the list to throw away the indexes and 341 | keep the data. 342 | 343 | Graphically, we can visualise the pipeline as follows, with types 344 | for the intermediate stages: 345 | 346 | zip filter (...) map snd 347 | [a] ---> [(Int, a)] ----------------> [(Int,a)] --------> [a] 348 | 349 | Unfortunately, 'everyOther' isn't particularly efficient. In any 350 | list of reasonable size, we'll be generating quite large numbers 351 | when all we are really interested in is whether or not they are 352 | odd. 353 | 354 | An alternative strategy is to zip with the infinite list 355 | 356 | [False, True, False, True, False, True, ...] 357 | 358 | This will produce a list like: 359 | 360 | [(False, x1), (True, x2), (False, x3), (True, x4), ...] 361 | 362 | Keeping the elements with 'True' in the first element will yield: 363 | 364 | [(True, x2), (True, x4), (True, x6), ...] 365 | 366 | And mapping 'snd' will give us: 367 | 368 | [x2, x4, x6, ...] 369 | 370 | as we want. 371 | 372 | Happily, the Haskell standard library function 'cycle' can produce 373 | infinite lists like [False, True, False, True, ...]. Given any 374 | finite list 'l', 'cycle l' repeats that list over and over again 375 | forever. We can use 'cycle' to code up this alternative strategy 376 | for 'everyOther': -} 377 | 378 | everyOther2 :: [a] -> [a] 379 | everyOther2 = map snd . filter fst . zip (cycle [False, True]) 380 | -------------------------------------------------------------------------------- /lectures/Lec17.hs: -------------------------------------------------------------------------------- 1 | module Lec17 where 2 | 3 | import Prelude hiding (const, take, iterate) 4 | import Debug.Trace 5 | 6 | {- LECTURE 17 : LAZY EVALUATION AND INFINITE DATA 7 | 8 | This lecture is about how Haskell evaluates programs, which is 9 | not the same as how most programming languages work. Haskell employs 10 | 'lazy evaluation', which means that values are never computed 11 | unless they are needed, and the 'same' value is never computed more 12 | than once. 13 | 14 | CREDITS: The 'inc', 'neverFinish', 'square' and 'sumList' examples 15 | are taken from Hutton's "Programming in Haskell", 2nd ed, Chapter 16 | 15. The 'findSqrt' example is taken from the paper "Why Functional 17 | Programming Matters" by John Hughes (link in the online notes). -} 18 | 19 | {- A simple function: -} 20 | 21 | inc :: Int -> Int 22 | inc n = n + 1 23 | 24 | {- How is the following evaluated? 25 | 26 | inc (2*3) 27 | -} 28 | 29 | {- 'Call by Value' 30 | 31 | inc (2*3) 32 | = { multiply 2 and 3 } 33 | inc 6 34 | = { definition of 'inc' } 35 | 6 + 1 36 | = { add } 37 | 7 38 | 39 | 'Call-by-Value' is so-called because it evaluates the arguments of 40 | functions to values before applying them. -} 41 | 42 | {- 'Call by Name' 43 | 44 | inc (2*3) 45 | = { definition of 'inc' } 46 | (2*3) + 1 47 | = { multiply } 48 | 6 + 1 49 | = { add } 50 | 7 51 | 52 | 'Call-by-Name' is so called because it just passes expressions 53 | whole to functions (i.e., a 'name' for the value). -} 54 | 55 | {- We could, in theory, mix Call-by-Value and Call-by-Name, but most 56 | languages pick one or the other to be the default, and offer the 57 | other via some special mechanism. -} 58 | 59 | {--------------------------------------------------------------------} 60 | {- Termination behaviour. 61 | 62 | Is there any difference between the two strategies? For programs 63 | that terminate under both, no, but there is a difference when we 64 | have programs that may not terminate. -} 65 | 66 | neverFinish :: Int 67 | neverFinish = 1 + neverFinish 68 | 69 | const :: a -> b -> a 70 | const a b = a 71 | 72 | {- What does this do? 73 | 74 | const 1 neverFinish 75 | -} 76 | 77 | {- 'Call by Value' 78 | 79 | const 1 neverFinish 80 | = 81 | const 1 (1 + neverFinish) 82 | = 83 | const 1 (1 + (1 + neverFinish)) 84 | = 85 | ... 86 | = 87 | const 1 (1 + ... (1 + neverFinish)) 88 | = 89 | ... 90 | -} 91 | 92 | {- 'Call by Name' 93 | 94 | const 1 neverFinish 95 | = { definition of 'const' } 96 | 1 97 | -} 98 | 99 | {- If there is *any* evaluation sequence that terminates, then CBN will 100 | also terminate and give the same answer. -} 101 | 102 | {--------------------------------------------------------------------} 103 | {- Sharing 104 | 105 | Naive Call-by-Name would lead to repeated work: -} 106 | 107 | square :: Int -> Int 108 | square x = x * x 109 | 110 | {- 111 | square (2*3) 112 | = { definition of square } 113 | (2*3) * (2*3) 114 | = { multiply } 115 | 6 * (2*3) 116 | = { multiply } 117 | 6 * 6 118 | = { multiply } 119 | 36 120 | -} 121 | 122 | {- But with Call-by-Value: 123 | 124 | square (2*3) 125 | = { multiply } 126 | square 6 127 | = { definition of square } 128 | 6 * 6 129 | = { multiply } 130 | 36 131 | -} 132 | 133 | {- So Haskell uses sharing to avoid repeatedly evaluating the same 134 | expression: 135 | 136 | square (2*3) 137 | = { give '2*3' a name so it can be shared } 138 | let x = 2*3 in square x 139 | = { definition of square } 140 | let x = 2*3 in x * x 141 | = { multiply (forced by '*') } 142 | let x = 6 in x * x 143 | = { fetch 'x' } 144 | let x = 6 in 6 * 6 145 | = { multiply } 146 | let x = 6 in 36 147 | = { garbage collect } 148 | 36 149 | 150 | 151 | This evaluation strategy is called 'Lazy evaluation': 152 | 153 | - Expressions are not evaluated until needed. 154 | - Expressions are not evaluated more than once. 155 | 156 | This strategy is realised by sharing computations that may be used 157 | more than once. This can be seen by using a feature of GHCi that 158 | allows us to print the value of a variable without evaluating it, 159 | and the ability to add a side-effecting trace message to any 160 | value that gets printed when it is evaluated. 161 | 162 | First we enter two expressions and give them names: 163 | 164 | λ> let x = 5 :: Int 165 | λ> let y = x * x 166 | 167 | We had to explicitly say that '5' is an 'Int' because otherwise 168 | Haskell doesn't know if we mean '5 :: Int', '5 :: Double', '5 :: 169 | Float', or '5 :: Integer'. 170 | 171 | Now if we look at 'x' with :sprint we can see that it is a value: 172 | 173 | λ> :sprint x 174 | x = 5 175 | 176 | But if we look at 'y', we can see that it has not yet been 177 | evaluated: 178 | 179 | λ> :sprint y 180 | y = _ 181 | 182 | If we ask for 'y' explicitly: 183 | 184 | λ> y 185 | 25 186 | 187 | Then using :sprint again will show us that 'y' now points to a 188 | value: 189 | 190 | λ> :sprint y 191 | y = 25 192 | 193 | This demonstrates that values are not evaluated unless they are 194 | needed. Another example is the following, which creates two 195 | suspended computations 'y' and 'z', and then only uses one of them: 196 | 197 | λ> let x = 5 :: Int 198 | λ> let y = x * x 199 | λ> let z = x + x 200 | λ> let a = const y z 201 | 202 | Inspecting 'y', 'z', and 'a' shows that no computation has happened 203 | yet: 204 | 205 | λ> :sprint y 206 | y = _ 207 | λ> :sprint z 208 | z = _ 209 | λ> :sprint a 210 | a = _ 211 | 212 | If we request the value of 'a', then we get it: 213 | 214 | λ> a 215 | 25 216 | 217 | And we can see that 'y' and 'a' are now resolved to values: 218 | 219 | λ> :sprint y 220 | y = 25 221 | λ> :sprint a 222 | a = 25 223 | 224 | But 'z' is still unevaluated: 225 | 226 | λ> :sprint z 227 | z = _ 228 | 229 | These examples show us that values are not evaluated unless they 230 | are needed, but not that they are only evaluated once. To see this, 231 | we can use a special function defined in the 'Debug.Trace' module 232 | that allows us to attach a string to be printed whenever an 233 | expression is evaluated. 234 | 235 | The 'trace' function takes a string and a value and returns the 236 | value. As a side effect it also prints the string. Note that this 237 | doesn't use the IO monad to do side-effects -- it is strictly 238 | speaking not a 'pure' functional programming. However it is very 239 | useful for debugging. 240 | 241 | Here's how to use it. We create three named expressions, 'x', 'y', 242 | 'z', but we wrap 'y' in a trace function. When we request the value 243 | of 'z', this requests the value of 'y' twice. Due to laziness, we 244 | only do the work once. We can see this because "Evaluating 'y'" is 245 | only printed once. The second time, 'y' just returns '25', and 246 | nothing is printed. 247 | 248 | λ> let x = 5 :: Int 249 | λ> let y = trace "Evaluating 'y'" (x * x) 250 | λ> let z = y + y 251 | λ> z 252 | Evaluating 'y' 253 | 50 254 | -} 255 | 256 | {--------------------------------------------------------------------} 257 | {- Laziness, Procrastination, and Strictness -} 258 | 259 | sumList :: Int -> [Int] -> Int 260 | sumList accum [] = accum 261 | sumList accum (x:xs) = sumList (accum + x) xs 262 | 263 | {- Evaluation under Call-by-Value: 264 | 265 | sumList 0 [1,2,3] 266 | = 267 | sumList (0+1) [2,3] 268 | = 269 | sumList 1 [2,3] 270 | = 271 | sumList (1+2) [3] 272 | = 273 | sumList 3 [3] 274 | = 275 | sumList (3+3) [] 276 | = 277 | sumList 6 [] 278 | = 279 | 6 280 | -} 281 | 282 | {- Evaluation under Call-by-Name or Lazy Evaluation: 283 | 284 | sumList 0 [1,2,3] 285 | = 286 | sumList (0+1) [2,3] 287 | = 288 | sumList ((0+1)+2) [3] 289 | = 290 | sumList (((0+1)+2)+3) [] 291 | = 292 | ((0+1)+2)+3 293 | = 294 | (1+2)+3 295 | = 296 | 3+3 297 | = 298 | 6 299 | -} 300 | 301 | {- For long lists, the 0+1+2+3+4+5+... builds up and is not evaluated 302 | until the end of the list. This can consume a large amount memory, 303 | and is known as a "space leak". 304 | 305 | This can lead to surprising behaviour, and can cause seemingly 306 | simple programs to run out of memory and crash. 307 | 308 | The fix in this case is to use strict application: -} 309 | 310 | sumStrict :: Int -> [Int] -> Int 311 | sumStrict accum [] = accum 312 | sumStrict accum (x:xs) = (sumStrict $! (accum+x)) xs 313 | 314 | {- The strict application operator: 315 | 316 | ($!) :: (a -> b) -> a -> b 317 | 318 | is 'magic' in the sense that it cannot be implemented in 'normal' 319 | Haskell. It evaluates the second argument before applying the 320 | function to it. With strict evaluation we get the 'Call-by-Value' 321 | behaviour as above. 322 | 323 | This function is actually implemented in terms of Haskell's basic 324 | function for forcing evaluation, called 'seq': 325 | 326 | seq :: a -> b -> b 327 | 328 | 'seq' always just returns its second argument, but only if its 329 | first argument can be evaluated to a 'head' value (this means that 330 | it only goes as far as the top most constructor. So, for example, 331 | if the first argument does not terminate, then 'seq' does not 332 | terminate: 333 | 334 | λ> seq neverFinish 1 335 | 336 | Interrupted. 337 | 338 | However, 'seq' is shallow in the sense that it only looks to 339 | evaluate its first argument to the 'first constructor'. For 340 | example: 341 | 342 | λ> seq [1..] 1 343 | 1 344 | 345 | Even though '[1..]' is an infinite list and can never be completely 346 | evaluated, it can be evaluated until it gets to the first ':' 347 | constructor. At this point, 'seq' returns its second argument. 348 | 349 | We can now use 'seq' to implement '$!': 350 | 351 | ($!) f a = a `seq` f a 352 | 353 | So 'seq' forces the argument 'a', and then applies 'f' to 'a'. Due 354 | to sharing, this means that the 'a' that 'f' sees has been 355 | evaluated down to a 'head' value. 356 | 357 | (Note: in versions of GHC >= 7.10, this is not actually how '$!' is 358 | implemented, due to interactions with GHC's optimiser. The '$!' in 359 | the standard library is actually implemented using strict pattern 360 | matching: 361 | 362 | ($!) f a = let !va = a in f va 363 | 364 | See https://ghc.haskell.org/trac/ghc/ticket/2273 for more details) 365 | -} 366 | 367 | {--------------------------------------------------------------------} 368 | {- Infinite Data 369 | 370 | A benefit of lazy evaluation is the ease of handling infinite data, 371 | and modularity benefits this can give to programs. 372 | 373 | Here is a function that generates infinite lists: -} 374 | 375 | upFrom :: Int -> [Int] 376 | upFrom i = i : upFrom (i+1) 377 | 378 | {- Trying to print out 'upFrom 0' will never terminate, but we can use 379 | various other functions to slice off bits of it. For example, 380 | 'take' takes some prefix of the list: -} 381 | 382 | take :: Int -> [a] -> [a] 383 | take 0 _ = [] 384 | take n (x:xs) = x : take (n-1) xs 385 | 386 | {- So: 387 | 388 | λ> take 5 (upFrom 0) 389 | [0,1,2,3,4] 390 | 391 | The benefit of laziness is that we don't have to make the decision 392 | that we are going to only take 5 elements of the list until the 393 | very end. If we were to implement this in a language that could 394 | only handle finite data, we would have to change 'upFrom' to take 395 | the number of elements that we needed. With laziness, we can do 396 | multiple manipulations to the list before deciding how many 397 | elements to use: 398 | 399 | λ> let numbers = upFrom 0 400 | λ> let evens = filter (\x -> x `mod` 2 == 0) numbers 401 | λ> let odds = filter (\x -> x `mod` 2 == 1) numbers 402 | λ> let square_evens = map (\x -> x * x) evens 403 | λ> let added_up = map (\(x,y) -> x+y) (zip square_evens odds) 404 | λ> take 10 added_up 405 | [1,7,21,43,73,111,157,211,273,343] 406 | 407 | Laziness can be useful for making programs more modular. Here 408 | is an example of finding square roots by generating an infinite 409 | list of approximations and then, separately, deciding how to cut it 410 | off (taken from "Why Functional Programming Matters" by John 411 | Hughes: 412 | 413 | https://www.cs.kent.ac.uk/people/staff/dat/miranda/whyfp90.pdf 414 | 415 | which is quite readable and uses a syntax very similar to Haskell.) 416 | 417 | The following function takes a number 'n' and a guess 'x' at the 418 | square root of 'n' and returns a better guess: -} 419 | 420 | next :: Double -> Double -> Double 421 | next n x = (x + n/x)/2 422 | 423 | {- If we can find a non-zero value 'x' such that 424 | 425 | next n x = x 426 | 427 | Then we have the square root of 'n'. This is because: 428 | 429 | (x + n/x)/2 = x 430 | <=> 431 | x + n/x = 2*x 432 | <=> 433 | n/x = x 434 | <=> 435 | n = x*x 436 | 437 | From the theory of Newton-Raphson root finding algorithms, we can 438 | approximate this value by starting from some initial guess and then 439 | repeatedly applying 'next n'. 440 | 441 | We can use this idea to generate an infinite list of 442 | approximations: -} 443 | 444 | -- This is defined in the standard library: 445 | iterate :: (a -> a) -> a -> [a] 446 | iterate f a = a : iterate f (f a) 447 | 448 | {- So 'iterate (next 2) 1' will give us an infinite list of 449 | approximations of the square root of 2, starting with the initial 450 | guess '1': 451 | 452 | λ> iterate (next 2) 1 453 | [1.0,1.5,1.4166666666666665,1.4142156862745097,1.4142135623746899, 454 | 1.414213562373095,1.414213562373095,1.414213562373095, 455 | 1.414213562373095,1.414213562373095 456 | 457 | Interrupted 458 | 459 | But how do we know when to stop? 460 | 461 | One way is to stop when the difference between two approximations 462 | is smaller than 'some small number': -} 463 | 464 | within :: Double -> [Double] -> Double 465 | within eps (a:b:xs) | abs (a-b) < eps = b 466 | within eps (_:b:xs) = within eps (b:xs) 467 | 468 | {- Now we can plug together 'within' and 'iterate (next n) 1' to make a 469 | square root finder: -} 470 | 471 | findSqrt :: Double -> Double 472 | findSqrt n = within 0.0000001 (iterate (next n) 1) 473 | 474 | {- And it works if we check against the built-in 'sqrt' function: 475 | 476 | λ> findSqrt 2 477 | 1.414213562373095 478 | λ> sqrt 2 479 | 1.4142135623730951 480 | 481 | However, when the number is small, using 'within' to cut off the 482 | search doesn't necessarily give a good answer: 483 | 484 | λ> findSqrt 0.00001 485 | 3.1622776602038957e-3 486 | λ> sqrt 0.00001 487 | 3.1622776601683794e-3 488 | 489 | When the numbers are small, a better strategy is to cut off when 490 | the ratio between two numbers in the sequence is close to 1: -} 491 | 492 | relative :: Double -> [Double] -> Double 493 | relative eps (a:b:xs) | abs (a/b - 1) < eps = b 494 | relative eps (_:b:xs) = relative eps (b:xs) 495 | 496 | {- We can now build another square root finder that works better for 497 | small numbers. Note that we did not have to change how we generated 498 | the sequence of approximations, only the check at the end. Laziness 499 | has allowed us to separate generating the approximations from 500 | checking them: -} 501 | 502 | findSqrt2 :: Double -> Double 503 | findSqrt2 n = relative 0.0000001 (iterate (next n) 1) 504 | 505 | {- We can now see that 'findSqrt2' does a better job on small numbers: 506 | 507 | λ> findSqrt2 0.00001 508 | 3.1622776601683794e-3 509 | λ> sqrt 0.00001 510 | 3.1622776601683794e-3 511 | -} 512 | -------------------------------------------------------------------------------- /lectures/Lec08.hs: -------------------------------------------------------------------------------- 1 | module Lec08 where 2 | 3 | {- LECTURE 08 : RECURSION SCHEMES 4 | 5 | In Lecture 5, we covered how to define recursive functions -- 6 | functions that are defined in terms of themselves. Recursion is the 7 | way that we write functional programs that compute with structures 8 | whose size is unknown at the time of writing the program. 9 | 10 | After writing a few recursive functions, we can see that they often 11 | fall into a few standard "patterns". The pattern we will look at in 12 | this lecture are recursive functions that systematically replace 13 | the constructors of a recursive data type with values and 14 | functions, building up a new value from a value of the 15 | datatype. This pattern is called 'iteration' over the data type (it 16 | is also sometimes called 'fold', but we reserve this for Foldable 17 | we will see in Lecture 09). Iteration turns out to be surprisingly 18 | expressive. -} 19 | 20 | {- For the first example, we will use the type of natural numbers, 21 | defined recursively in terms of 'Zero' and 'Succ': -} 22 | 23 | data Nat 24 | = Zero 25 | | Succ Nat 26 | deriving Show 27 | 28 | {- Values of type 'Nat' are built by using the constructors. We can 29 | check the types of the constructors by using GHCi: 30 | 31 | λ> :t Zero 32 | Zero :: Nat 33 | λ> :t Succ 34 | Succ :: Nat -> Nat 35 | 36 | The idea is that 'Zero' represents '0' and 'Succ' represents 37 | '+1'. So we can represent any positive whole number by starting 38 | from Zero and using Succ as many times as we need. 39 | 40 | Here are two example values of type 'Nat': 'one' and 'two'. -} 41 | 42 | one = Succ Zero 43 | two = Succ one 44 | 45 | {- Addition of 'Nat's can be defined by the following recursively 46 | defined function. We will look at the structure of this function to 47 | see the underlying 'pattern' of recursion that is being used: -} 48 | 49 | plus :: Nat -> Nat -> Nat 50 | plus Zero n = n 51 | plus (Succ m) n = Succ (plus m n) 52 | 53 | {- Looking at 'plus' we can see that 'n' is left unchanged thoughout, so 54 | we can rewrite it to make this clearer: -} 55 | 56 | plus' :: Nat -> Nat -> Nat 57 | plus' m n = plusHelper m 58 | where plusHelper Zero = n 59 | plusHelper (Succ m) = Succ (plusHelper m) 60 | 61 | {- Looking at 'plusHelper', we can make two observations: 62 | 63 | 1. There is a line for each constructor of the 'Nat' type, 64 | declaring what to do for each constructor. 65 | 66 | 2. The recursive call to 'plusHelper' in the 'Succ' case is on 'm'. 67 | The function doesn't look at the value of 'm' directly, it only 68 | uses the value recursively generated from it. 69 | 70 | We can summarise 'plusHelper' by what it does on the two 71 | constructors: On Zero, it returns 'n'. On (Succ m) it applies Succ 72 | to the result of recursively processing 'm'. 73 | 74 | This pattern of returning a value for 'Zero' and applying a 75 | function for 'Succ' is very common, and we term this process 76 | 'iteration'. Iteration for natural numbers of expressed by the 77 | 'iterNat' function: -} 78 | 79 | iterNat :: a -> (a -> a) -> Nat -> a 80 | iterNat zero succ Zero = zero 81 | iterNat zero succ (Succ n) = succ (iterNat zero succ n) 82 | 83 | {- The type of 'iterNat' states: 84 | 85 | iterNat :: a -- a value to use for 'Zero' 86 | -> (a -> a) -- a function to use for 'Succ' 87 | -> Nat -- a Nat to look at 88 | -> a -- the value returned by looking at the Nat 89 | 90 | See? We are systematically replacing the constructors in any value 91 | of 'Nat' with the value and argument provided. 92 | 93 | To see how to use 'iterNat', let's write 'plus' using it: -} 94 | 95 | plus2 :: Nat -> Nat -> Nat 96 | plus2 m n = iterNat -- 'a = Nat' 97 | n -- zero case 98 | Succ -- (\plus2_m_n -> Succ plus2_m_n) -- succ case 99 | m 100 | 101 | {- To use 'iterNat', we must provide the 'Zero' and 'Succ' 102 | cases. Following the discussion above, we use 'n' for the 'Zero' 103 | case, and 'Succ' for the 'Succ' case. 104 | 105 | Another way to write 'plus' using 'iterNat' is to pass around 'n' 106 | each time, just as we did in the original definition of 'plus'. We 107 | accomplish this by using 'iterNat' to build a function 'Nat -> Nat' 108 | instead of to build a 'Nat'. This means that we are using 'iterNat' 109 | with type 'a = Nat -> Nat': -} 110 | 111 | plus3 :: Nat -> (Nat -> Nat) 112 | plus3 m = iterNat -- 'a = Nat -> Nat' 113 | id -- zero case 114 | (\plus3_m n -> Succ (plus3_m n)) -- succ case 115 | m 116 | 117 | {- In 'plus3', the 'Zero' case is the identity function 'id', which just 118 | takes 'n' and returns 'n'. In the 'Succ' case, we are given the 119 | result of computing 'plus3_m' and we are given 'n', so we use 120 | 'plus3_m n' to get the result of adding 'm' to 'n', and then apply 121 | 'Succ'. 122 | 123 | Passing 'n' around gives us some more flexibility. Here is a 124 | version of plus that modifies 'n' as it goes, adding one to 'n' for 125 | every 'Succ' discovered in 'm': -} 126 | 127 | plus4 :: Nat -> Nat -> Nat 128 | plus4 m = iterNat -- 'a = Nat -> Nat' 129 | id -- zero 130 | (\plus4_m n -> plus4_m (Succ n)) -- succ 131 | m 132 | 133 | {- On natural numbers 'plus3' and 'plus4' are equivalent, because one 134 | 'Succ' looks like every other 'Succ'. However, if we attached 135 | values to the 'Succ's (e.g. as we do in lists), then they would 136 | have different behaviour. -} 137 | 138 | {- The following function is an interesting special case. What happens 139 | when we use 'Zero' as the value for 'Zero', and 'Succ' as the 140 | function for 'Succ'? -} 141 | 142 | thingy :: Nat -> Nat 143 | thingy = iterNat Zero Succ 144 | 145 | {- We get the identity function! 'thingy x' is always equal to 146 | 'x'. Replacing each constructor with itself gives us back the 147 | original value. This may seem like just a useless way to compute 148 | nothing, but this technique will be useful for keeping track of 149 | where we are in a recursive computation. -} 150 | 151 | {- Let's look at another example of a function on 'Nat's: the equality 152 | testing function. 153 | 154 | We can start to define this function using 'iterNat' as follows: -} 155 | 156 | eqNat0 :: Nat -> Nat -> Bool 157 | eqNat0 = iterNat -- 'a = Nat -> Bool' 158 | undefined -- need an 'is this zero?' test 159 | (\eqNat_m n -> undefined) -- need to determine whether Succ 160 | -- m = n, given a function that 161 | -- can answer is 'x' equal to 162 | -- 'm'? 163 | 164 | {- There are two holes left in the definition. To fill in the first one 165 | we need to write a function that determines whether a 'Nat' is 166 | 'Zero'. We can do this with a 'case' expression: -} 167 | 168 | eqNat1 :: Nat -> Nat -> Bool 169 | eqNat1 = iterNat -- 'a = Nat -> Bool' 170 | (\n -> case n of 171 | Zero -> True 172 | Succ _ -> False) 173 | (\eqNat_m n -> undefined) 174 | 175 | {- To fill in the second hole, we need a function that can answer "is 176 | Succ m = n", given a test that can answer "is m = x", for any 177 | "x". Thinking a bit, we can see that "Succ m = n" is only true if 178 | "n = Succ n'" for some n'. So we use a 'case' expression again: -} 179 | 180 | eqNat2 :: Nat -> Nat -> Bool 181 | eqNat2 = iterNat -- 'a = Nat -> Bool' 182 | (\n -> case n of 183 | Zero -> True 184 | Succ _ -> False) 185 | (\eqNat_m n -> case n of 186 | Zero -> False 187 | Succ n' -> eqNat_m n') 188 | 189 | {- Let's step through a run of 'eqNat2' to get a feel for what is going 190 | on. We write 191 | 192 | zeroCase = (\n -> case n of 193 | Zero -> True 194 | Succ _ -> False) 195 | 196 | succCase = (\eqNat_m n -> case n of 197 | Zero -> False 198 | Succ n' -> eqNat_m n') 199 | 200 | so that eqNat2 = iterNat zeroCase succCase. 201 | 202 | eqNat2 (Succ Zero) (Succ (Succ Zero)) 203 | = { write superfluous brackets for emphasis } 204 | (eqNat2 (Succ Zero)) (Succ (Succ Zero)) 205 | = { expand definition of eqNat2 } 206 | (iterNat zeroCase succCase (Succ Zero)) (Succ (Succ Zero)) 207 | = { definition of iterNat ... (Suc Zero) } 208 | (succCase (iterNat zeroCase succCase Zero)) (Succ (Succ Zero)) 209 | = { expand definition of succCase } 210 | (\eqNat_m n -> case n of Zero -> False; Succ n' -> eqNat_m n') 211 | (iterNat zeroCase succCase Zero) 212 | (Succ (Succ Zero)) 213 | = { application of a lambda expression to arguments } 214 | case (Suc (Suc Zero)) of 215 | Zero -> False 216 | Succ n' -> (iterNat zeroCase succCase Zero) n' 217 | = { case expression of a constructor } 218 | (iterNat zeroCase succCase Zero) (Suc Zero) 219 | = { definition of iterNat ... Zero } 220 | zeroCase (Suc Zero) 221 | = { expand definition of zeroCase } 222 | (\n -> case n of Zero -> True; Succ _ -> False) (Suc Zero) 223 | = { application of a lambda expression to arguments } 224 | case (Suc Zero) of Zero -> True; Succ _ -> False 225 | = { case expression of a constructor } 226 | False 227 | 228 | So 'one' is not equal to 'two'. Try stepping through 229 | eqNat2 (Suc Zero) (Suc Zero) yourself! 230 | -} 231 | 232 | 233 | {- Explicitly pattern matching seems to go against the spirit of 234 | 'iterNat'. Can we replace the 'case' expressions with uses of 235 | 'iterNat'? 236 | 237 | For the 'Zero' case, where we need a 'is Zero' test, this is 238 | possible. To identify 'Zero's, we replace every 'Zero' with 'True' 239 | and every 'Succ' with the constantly 'False' function: -} 240 | 241 | eqNat3 :: Nat -> Nat -> Bool 242 | eqNat3 = iterNat -- 'a = Nat -> Bool' 243 | (iterNat True (\_ -> False)) 244 | (\eqNat_m n -> case n of 245 | Zero -> False 246 | Succ n' -> eqNat_m n') 247 | 248 | {- The 'Succ' case is more difficult. If we break it out into its own 249 | function, we can see the problem. -} 250 | 251 | succCase :: (Nat -> Bool) -> Nat -> Bool 252 | succCase eqNat_m = iterNat False (\succCase_eqNat_m_n -> undefined) 253 | 254 | {- To fill in the 'undefined' part, we have the following task. Given a 255 | number 'Succ n', and the result of 'eqNat_m_n' we want to know 256 | whether 'm' is equal to 'Succ n'. Working this out from the 257 | available information is impossible! 258 | 259 | The problem is that 'iterNat' doesn't give us the 'n' from the 260 | 'Succ n', only the result of recursively processing it. We seem to 261 | need a new kind of recursion scheme to handle this case. We define 262 | 'caseNat' to capture the pattern being used in the 'case' 263 | expressions: -} 264 | 265 | caseNat :: a -> (Nat -> a) -> Nat -> a 266 | caseNat zero succ Zero = zero 267 | caseNat zero succ (Succ k) = succ k 268 | 269 | {- 'caseNat' is similar to 'iterNat', except that it does not call 270 | itself recursively. The 'Nat' 'k' is passed directly into the 271 | 'succ' function. 272 | 273 | Using 'caseNat', we can write 'eqNat' without explicit recursion or 274 | pattern matching: -} 275 | 276 | eqNat :: Nat -> Nat -> Bool 277 | eqNat = iterNat -- 'a = Nat -> Bool' 278 | (iterNat True (\eq_Zero_k -> False)) 279 | (\ eqNat_m -> caseNat False 280 | (\ k -> eqNat_m k)) 281 | 282 | {- The existence of 'iterNat' and 'caseNat' is unsatisfying. Is there a 283 | recursion scheme that gives us access to both the recursive result 284 | and the value being examined? 285 | 286 | 'recNat' is a recursion scheme that does this: -} 287 | 288 | recNat :: a -> ((Nat,a) -> a) -> Nat -> a 289 | recNat zero succ Zero = zero 290 | recNat zero succ (Succ n) = succ (n, recNat zero succ n) 291 | 292 | {- Compared to 'caseNat', 'recNat' calls itself recursively. Compared to 293 | 'iterNat', the 'Succ n' case passes 'n' to the 'succ' function. 294 | 295 | Because it passes more information to 'succ', 'recNat' appears to 296 | be more powerful than 'iterNat'. However, this extra power is 297 | illusory because we can implement 'recNat' from 'iterNat' by 298 | building a copy of the 'Nat' we are processing. This uses the same 299 | technique as 'thingy' above. 300 | 301 | The tricky to defining 'recNat' is to use 'iterNat' to compute a 302 | pair (n,b) consisting of: 'n', a copy of the natural being 303 | processes; and 'b' the result required. At the end of the 304 | computation, we use 'snd' to get the final result, and discard the 305 | 'Nat', which was only needed for intermediate computations. -} 306 | 307 | recNatFromIterNat :: b -> ((Nat,b) -> b) -> Nat -> b 308 | recNatFromIterNat zero succ n 309 | = snd (iterNat -- 'a = (Nat, b)' 310 | (Zero, zero) 311 | (\(n, rec_n) -> (Succ n, succ (n, rec_n))) 312 | n) 313 | 314 | {- See how the Zero and Succ cases return a 'Nat' built from 'Zero' and 315 | 'Succ', building a copy of the 'Nat' that was started with. Compare 316 | this to the 'thingy' function above. 317 | 318 | It is also possible to avoid the unpacking and repacking of the 319 | pair in the 'Succ' case by using an "@ pattern" that makes 'x' 320 | stand for the whole pair, while 'n' and 'n_rec' stand for the first 321 | and second parts of the pair, respectively: 322 | 323 | (\x@(n,rec_n) -> (Succ n, succ x)) 324 | 325 | Note that defining 'recNat' in this way is not necessarily 326 | recommended, for efficiency reasons. This implementation builds a 327 | data structure in memory that is an exact copy of the existing 328 | structure, wasting memory. The point is that 'iterNat' is 329 | expressive enough to capture this apparently more general recursion 330 | scheme. This expressivity is important when using functions with 331 | interfaces like 'iterNat's that don't operate over concrete data 332 | structures, but operate over the output of some process where there 333 | is not concrete data structure. -} 334 | 335 | {- Now let's look at another example of iteration over data. Here is a 336 | data type for describing arithmetic expressions consisting of 337 | numbers and addition: -} 338 | 339 | data Expr 340 | = Number Int 341 | | Add Expr Expr 342 | deriving Show 343 | 344 | {- Let's see now how to systematically derive the type of an 'iterExpr' 345 | function from this data declaration. 346 | 347 | 1. We want a function that takes 'Expr's and returns values of any 348 | type 't', but we don't know yet what the other argument types 349 | are. So we write this down: 350 | 351 | iterExpr :: ???? -> Expr -> t 352 | 353 | 2. Iteration works on a constructor-by-constructor basis -- 354 | replacing each use of a constructor by a function call. So, to 355 | work out the other argument types, we take the types of the 356 | constructors: 357 | 358 | λ> :t Number 359 | Number :: Int -> Expr 360 | λ> :t Add 361 | Add :: Expr -> Expr -> Expr 362 | 363 | Plugging these types into the type of iterExpr gives: 364 | 365 | iterExpr :: (Int -> Expr) -> (Expr -> Expr -> Expr) -> Expr -> t 366 | \_ Number \_ Add 367 | 368 | 3. Now we systematically replace 'Expr' by 't' in the types taken 369 | from the constructors. Why? Because we will be using these 370 | functions to construct new values of type 't', following the 371 | structure of the 'Expr' that is given to us. If we left them as 372 | 'Expr' then our function would be less general that it could be 373 | -- we would only be able to construct 'Expr's from 'Expr's. 374 | 375 | iterExpr :: (Int -> t) -> (t -> t -> t) -> Expr -> t 376 | 377 | Performing this change gives us the type of 'iterExpr'. 378 | 379 | EXERCISE: repeat this same process with the Nat type above and with 380 | the List type ([a]). You should get the same answers as for 381 | 'iterNat' above and 'iterRight' in Ex3. 382 | 383 | Now that we have the type of 'iterExpr', the implementation follows 384 | the exact same pattern as 'iterNat' above: we match on the 385 | constructors of 'Expr' and use the corresponding function: -} 386 | 387 | iterExpr :: (Int -> t) -> (t -> t -> t) -> Expr -> t 388 | iterExpr number add (Number i) = number i 389 | iterExpr number add (Add d e) = 390 | add (iterExpr number add d) (iterExpr number add e) 391 | 392 | {- In Lecture 10 we will see some more functions that use 393 | 'iterExpr'. -} 394 | -------------------------------------------------------------------------------- /lectures/Lec01.hs: -------------------------------------------------------------------------------- 1 | module Lec01 where 2 | 3 | {- LECTURE 01 : PROGRAMS MADE OF EQUATIONS; RUNNING THEM 4 | 5 | 6 | 7 | Welcome to the first lecture of the University of Strathclyde's 8 | "Functional Programming" course! 9 | 10 | Most of the lectures will be delivered by live Haskell coding on 11 | the projector. We take the final version of the code and annotate 12 | it with comments after the lecture to help you understand what is 13 | going on, and to recreate some of the things we said during the 14 | lecture. 15 | 16 | This first lecture introduces the two main concepts in Haskell: 17 | 18 | 1. Defining what data is. 19 | 20 | 2. Transforming data by pattern matching. 21 | 22 | We will cover both of these in a lot more depth later in the 23 | course. This lecture is a first introduction to the concepts. We 24 | will also introduce the concept of 'type' and how it relates to 25 | these concepts. 26 | 27 | In the lecture we introduced the "Evaluation Game" that allows us 28 | to interactively see how pattern matching is used to run 29 | programs. This is the first exercise for this course. See the main 30 | page for instructions on how to access it. -} 31 | 32 | 33 | 34 | {- PART 1 : DEFINING DATA 35 | 36 | In Haskell, pieces of data always start with capital letters, or 37 | are numbers, characters, or strings. Pieces of data that start with 38 | a capital letter are called 'constructors'. 39 | 40 | Examples: 'Nil', or 'True', or 'False', or '1234'. 41 | 42 | Before we can use any old capitalised word as a piece of data, we 43 | need to tell Haskell which words we want to use, and how they are 44 | grouped into datatypes. For example, 'True' and 'False' are grouped 45 | into the 'Bool' type. 46 | 47 | We'll introduce this by an example. Here is a Haskell 'data' 48 | declaration that defines a new type 'List' that contains two 49 | constructors 'Nil' and 'Cons': -} 50 | 51 | data List a = Nil | Cons a (List a) 52 | deriving Show 53 | 54 | {- In English, we read this declaration as: 55 | 56 | A 'List' of 'a's is either: 57 | - 'Nil'; or 58 | - 'Cons', followed by an 'a' and a 'List' of 'a's. 59 | 60 | The symbol '|' is read as 'or'. So another way to read this 61 | declaration is: "a List is either Nil or a Cons". 62 | 63 | Note that the type 'a' can stand for any other type. So we can have 64 | lists containing data of any type. 65 | 66 | NOTE: the 'deriving Show' is an instruction to the Haskell 67 | compiler to generate a function for converting 'List's to 68 | strings. Think of this as auto-generating something similar to 69 | Java's 'toString()' methods. 70 | 71 | NOTE: The names 'Nil' and 'Cons' to stand for the empty list and 72 | a list with one extra element originally come from the Lisp 73 | programming language, one of the oldest programming 74 | languages. 'Cons' is short for 'Construct'. For historical 75 | interest, see the original paper on Lisp by John McCarthy: 76 | 77 | John McCarthy: Recursive Functions of Symbolic Expressions and 78 | Their Computation by Machine, Part I. Commun. ACM 3(4): 79 | 184-195 (1960) 80 | 81 | PDF at: http://www-formal.stanford.edu/jmc/recursive.pdf 82 | 83 | 84 | Now lets see some examples of data of type 'List a' for some 'a's, 85 | and how we can deduce that they are actually lists. 86 | 87 | Here is our first example: -} 88 | 89 | ex1 :: List Int 90 | ex1 = Cons 2 (Cons 7 (Cons 1 Nil)) 91 | 92 | {- Haskell syntax: this definition consists of two lines: 93 | 94 | - The first line names the thing we are defining, 'ex1', and gives 95 | its type 'List Int' (meaning "List of Ints"). The symbol '::' is 96 | read as "has type". 97 | 98 | - The second line names the definition again, and the text to the 99 | right of the 'equals' is what we are defining 'ex1' to be. 100 | 101 | So, altogether, we are defining 'ex1', of type 'List Int', to be 102 | 'Cons 2 (Cons 7 (Cons 1 Nil))'. 103 | 104 | In Haskell, we must always make sure that the definition we give 105 | matches the type. In the lecture, we worked through on the board 106 | how we can see that 'ex1' is of type 'List Int'. Let's go through 107 | it here: 108 | 109 | GOAL: 'Cons 2 (Cons 7 (Cons 1 Nil)) :: List Int' 110 | 111 | From what we said above, a list is either 'Nil' or a 'Cons'. In 112 | this case we have a 'Cons' and it must be followed by an 'Int' 113 | and a 'List Int'. So we check: 114 | 115 | * '2' is an 'Int' -- Yes! 116 | 117 | * 'Cons 7 (Cons 1 Nil)' is a 'List Int', this is a 'Cons', so we 118 | check again: 119 | 120 | - '7' is an 'Int' -- Yes! 121 | 122 | - 'Cons 1 Nil' is a 'List Int', so we check: 123 | 124 | + '1' is an 'Int' -- Yes! 125 | 126 | + 'Nil' is a 'List Int' -- Yes! because 'Nil' is one of the 127 | constructors of 'List a', for any 'a'. 128 | 129 | So we can now confidently say that 'Cons 2 (Cons 7 (Cons 1 Nil))' 130 | is of type 'List Int'. Of course, the Haskell compiler will check 131 | this for us, but it is useful to know what is going on when it does 132 | this check. 133 | 134 | If we load this file into the GHCi interactive Haskell REPL, we can 135 | see that it succeeds: 136 | 137 | GHCi, version 7.10.3: http://www.haskell.org/ghc/ :? for help 138 | Prelude> :l Lec01.hs 139 | [1 of 1] Compiling Lec01 ( Lec01.hs, interpreted ) 140 | Ok, modules loaded: Lec01. 141 | *Lec01> 142 | 143 | Let's now see what happens when we try something that is not a 144 | valid list: 145 | 146 | ex2 :: List ?? 147 | ex2 = Cons Nil (Cons 1 Nil) 148 | 149 | In this example (which is commented out so that you can load this 150 | file into GHCi for experimentation), we have not even been able to 151 | fill in the '??'. If we go through the same process as before for 152 | checking whether 'ex2' is a list we end up in a situation where 153 | 'Nil' and '1' must have the same type. However, 'Nil' is a 'List a' 154 | (for some 'a'), and '1' is a number. If we try to get GHCi to 155 | accept our definition, it returns an error message: 156 | 157 | *Lec01> :l Lec01.hs 158 | [1 of 1] Compiling Lec01 ( Lec01.hs, interpreted ) 159 | 160 | Lec01.hs:160:22: 161 | No instance for (Num (List a0)) arising from the literal ‘1’ 162 | In the first argument of ‘Cons’, namely ‘1’ 163 | In the second argument of ‘Cons’, namely ‘(Cons 1 Nil)’ 164 | In the expression: Cons Nil (Cons 1 Nil) 165 | Failed, modules loaded: none. 166 | 167 | This error gives a lot of information, but in essence it is saying 168 | that Haskell cannot work out how to treat lists as numbers. 169 | 170 | Our final example shows that it is possible to have lists of lists, 171 | and that it is possible to get Haskell to infer types for us in 172 | many situations. 173 | 174 | Here, we just give a definition without a type. -} 175 | 176 | ex3 = Cons Nil (Cons Nil Nil) 177 | 178 | {- In general, this is bad style. It is very helpful for readers to be 179 | able to see the types of every definition in a Haskell program, as 180 | an aid to understanding. In this course, we will be careful to give 181 | types for all our definitions. 182 | 183 | However, it can be useful during development to leave off some of 184 | the types so that we can find out what Haskell thinks the types 185 | ought to be. We can do this by loading the file into GHCi and 186 | making a type query using the special command ':t' (short for 187 | ':type'): 188 | 189 | Prelude> :l Lec01.hs 190 | [1 of 1] Compiling Lec01 ( Lec01.hs, interpreted ) 191 | Ok, modules loaded: Lec01. 192 | *Lec01> :t ex3 193 | ex3 :: List (List a) 194 | *Lec01> 195 | 196 | GHCi has told us that the type of 'ex3' is 'List (List a)' -- it is 197 | a list of lists of 'a's, for any type 'a'. -} 198 | 199 | {- Haskell already has a built-in list type so we don't need to define 200 | our own every time we want to use lists. Lists are used so often in 201 | Haskell (possibly too much) that they get their own special syntax. 202 | 203 | Instead of writing the type 'List a', the built-in type is written 204 | '[a]', read as "list of 'a's". 205 | 206 | Instead of writing 'Nil', the empty list is written '[]'. 207 | 208 | Instead of writing 'Cons x xs', we write 'x : xs'. This is spoken 209 | as 'x cons xs'. 210 | 211 | It is possible to write lists using ':' and '[]', for example: -} 212 | 213 | ex1' :: [Int] 214 | ex1' = 2 : 7 : 1 : [] 215 | 216 | {- However, it is much more convenient to write them using the compact 217 | list notation: a sequence of values surrounded by square brackets, 218 | separated by commas. The three examples we gave above are written 219 | like so in this notation: -} 220 | 221 | ex1'' :: [Int] 222 | ex1'' = [2,7,1] 223 | 224 | -- ex2'' :: [??] 225 | -- ex2'' = [[], 1] 226 | 227 | ex3'' :: [[a]] 228 | ex3'' = [[], []] 229 | 230 | 231 | {- PART 2 : TRANSFORMING DATA BY PATTERN MATCHING 232 | 233 | If Haskell only had data, then it would not be a very interesting 234 | programming language (though it could still be a useful data 235 | language like JSON or XML). 236 | 237 | To transform data in Haskell, we define functions by /pattern 238 | matching/. This means that every function is a list of patterns of 239 | data that it can match with, and for each pattern a description of 240 | how that data is transformed. 241 | 242 | Here is an example, which totals up all the elements in a list of 243 | 'Int's: -} 244 | 245 | total :: List Int -> Int 246 | total Nil = 0 247 | total (Cons x xs) = x + total xs 248 | 249 | {- As above, definitions consist of multiple lines. Here we have three 250 | lines: one type definition line, and two patterns. The first line 251 | describes the type of the thing we are defining. In this case, we 252 | are defining 'total' which has type 'List Int -> Int'. We read this 253 | as "functions that take Lists of Ints and return Ints". The 254 | analogous Java type would be: 255 | 256 | int total(List input) 257 | 258 | Note that Haskell types go left to right! 259 | 260 | The second and third lines describe the two patterns of data that 261 | 'total' matches on, and what it does in those two cases. 262 | 263 | 'total Nil = 0' says "when total is applied to 'Nil', the answer is 264 | '0'". Put another way, the total of the empty list is '0'. 265 | 266 | 'total (Cons x xs) = x + total xs' says "when total is applied to 267 | 'Cons x xs', the answer is 'x' added to whatever the total of 'xs' 268 | is". 269 | 270 | NOTE: We have used a naming convention common in Haskell 271 | programming. The 'head' element of the list is called 'x' 272 | (because it is some unknown), and the rest of the list is called 273 | 'xs' -- the "plural" of 'x'. In general, the '-s' suffix is used 274 | for lists. 275 | 276 | NOTE: Haskell programmers are sometimes criticised for their use 277 | of short names like 'x' and 'xs', rather than longer names like 278 | 'theNumber' and 'restOfTheList'. Our feeling is that, while 279 | Haskell programmers do sometimes go overboard with short names, 280 | short names are very useful for maintaining a clear view of the 281 | *shape* of the code. When defining functions by pattern 282 | matching, it is often the shapes that are important, not the 283 | specifics. 284 | 285 | Running 'total' on some lists in GHCi should convince us that it is 286 | actually computing the totals of lists of Ints: 287 | 288 | *Lec01> total Nil 289 | 0 290 | *Lec01> total (Cons 1 Nil) 291 | 1 292 | *Lec01> total (Cons 1 (Cons 3 Nil)) 293 | 4 294 | *Lec01> total (Cons 1 (Cons 3 (Cons 5 Nil))) 295 | 9 296 | 297 | We can also see how total works by stepping through the pattern 298 | matching process by hand. Let's take the third example: 299 | 300 | total (Cons 1 (Cons 3 Nil)) 301 | = by the second rule for total 302 | 1 + total (Cons 3 Nil) 303 | = by the second rule for total 304 | 1 + (3 + total Nil) 305 | = by the first rule for total 306 | 1 + (3 + 0) 307 | = by (built in) arithmetic 308 | 1 + 3 309 | = by (built in) arithmetic 310 | 4 311 | 312 | As you'll've seen in the "Evaluation Game" exercise, quite complex 313 | behaviour can be built up by pattern matching and reduction. 314 | 315 | Note that 'total' can only be applied to data that is of type 'List 316 | Int'. If we try to apply 'total' to a list of booleans ('True's and 317 | 'False's), then GHCi will complain: 318 | 319 | *Lec01> total (Cons True Nil) 320 | 321 | :14:13: 322 | Couldn't match expected type ‘Int’ with actual type ‘Bool’ 323 | In the first argument of ‘Cons’, namely ‘True’ 324 | In the first argument of ‘total’, namely ‘(Cons True Nil)’ 325 | 326 | Importantly, GHCi complained *before* trying to execute the 327 | program. In Haskell, all type checking occurs before execution 328 | time. For this reason, Haskell is known as a "statically typed" 329 | language. This puts it in the same category as Java, though, as 330 | you'll see in this course, Haskell's type system is more expressive 331 | than Java's. An alternative (called "dynamic typing") is 332 | implemented in languages like Javascript, Python, Scheme, and other 333 | languages in the Lisp family. 334 | 335 | Let's see what would happen in a version of Haskell without a type 336 | checker: 337 | 338 | total (Cons True Nil) 339 | = by the second rule for total 340 | True + total Nil 341 | = by the first rule for total 342 | True + 0 343 | = cannot add booleans to Ints! 344 | << ERROR >> 345 | 346 | In Haskell, we try to avoid errors occurring at runtime like this 347 | by using types. Types are also useful as machine checked 348 | documentation for programs that describe the sorts of data that are 349 | expected as inputs and outputs for each part of the program. As we 350 | will see in this course, and much more so in the CS410 course in 351 | the fourth year, we can also use types to guide the process of 352 | writing programs. Our philosophy is that types are a design 353 | language that aids and guides us in writing programs. -} 354 | 355 | {- 'total' is not the only function we can define on 'List's. Another 356 | useful function is 'append', which concatenates two lists. We again 357 | define this by pattern matching: -} 358 | 359 | append :: List a -> List a -> List a 360 | append Nil ys = ys 361 | append (Cons x xs) ys = Cons x (append xs ys) 362 | 363 | {- The type of 'append' states that it takes a 'List' of 'a's, another 364 | 'List' of 'a's, and returns a 'List' of 'a's. Note that 'append' is 365 | polymorphic (or "generic") in the actual type of elements of the 366 | lists. We do not need to write a separate append function for lists 367 | of Ints and lists of Strings. 368 | 369 | Line two states that, when the first argument is 'Nil', the result 370 | is the second argument 'ys' (following the naming convention we 371 | described above). This makes sense: appending a list on to the 372 | empty list should just return the list. 373 | 374 | Line three states that, when the second argument is 'Cons x xs', 375 | the result is 'Cons x (append xs ys)'. That is -- we append xs to 376 | ys, and put the 'x' on the front. It might not be easy to see that 377 | this works straight away. Here is the example we used in the 378 | lecture: 379 | 380 | append (Cons "Unicorn" (Cons "Rainbow" Nil)) (Cons "Pegasus" Nil) 381 | = { by the first rule } 382 | Cons "Unicorn" (append (Cons "Rainbow" Nil) (Cons "Pegasus" Nil)) 383 | = { by the first rule } 384 | Cons "Unicorn" (Cons "Rainbow" (append Nil (Cons "Pegasus" Nil))) 385 | = { by the second rule } 386 | Cons "Unicorn" (Cons "Rainbow" (Cons "Pegasus" Nil)) 387 | 388 | So, 'append' has successfully concatenated the two lists. You will 389 | have seen many more examples of 'append' in action in the 390 | Evaluation Game. 391 | 392 | We can also get GHCi to check our work: 393 | 394 | *Lec01> append (Cons "Unicorn" (Cons "Rainbow" Nil)) (Cons "Pegasus" Nil) 395 | Cons "Unicorn" (Cons "Rainbow" (Cons "Pegasus" Nil)) 396 | 397 | Finally, we mention that, just as Haskell has a type of lists 398 | pre-defined, it also has functions for adding up lists and 399 | appending lists pre-defined. The function to add up a list is 400 | called 'sum' (indeed 'sum' is more general and can be used to add 401 | up any container containing numbers), and the function to append 402 | two lists is called '++' and is written in infix notation: 403 | 404 | *Lec01> ["Unicorn", "Rainbow"] ++ ["Pegasus"] 405 | ["Unicorn","Rainbow","Pegasus"] 406 | 407 | This concludes our first introduction to Haskell's data, functions, 408 | and types. In the next lecture, we will discuss some of the 409 | standard types that are pre-defined in Haskell, and the data that 410 | inhabits those types. -} 411 | --------------------------------------------------------------------------------