├── .gitignore ├── Setup.hs ├── hie.yaml ├── src └── Main.hs ├── stack.yaml.lock ├── LICENSE ├── CS316-Y2022.cabal ├── stack.yaml ├── lecture-notes ├── Week07Problems.hs ├── Week01Intro02.hs ├── Week08Problems.hs ├── Week03Intro01.hs ├── Week07Intro.hs ├── Week02Intro.hs ├── Week08Solutions.hs ├── Intro.hs ├── Week01Problems.hs ├── Week01Intro.hs ├── Week04Problems.hs ├── Week06Problems.hs ├── Week07Solutions.hs ├── Week05Intro.hs ├── Week02Problems.hs ├── Week09Intro.hs ├── Week03Problems.hs ├── Week06Solutions.hs ├── Week04Intro.hs ├── Week08Intro.hs ├── Week01Solutions.hs ├── Week06Intro.hs ├── Week05Problems.hs ├── Week03Solutions.hs ├── Week04Solutions.hs ├── Week05Solutions.hs ├── Week02Solutions.hs └── Week07.hs └── README.md /.gitignore: -------------------------------------------------------------------------------- 1 | *~ 2 | /.stack-work/ 3 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /hie.yaml: -------------------------------------------------------------------------------- 1 | cradle: 2 | stack: 3 | - path: "./lecture-notes" 4 | component: "CS316-Y2022:lib" 5 | - path: "./src" 6 | component: "CS316-Y2022:exe:hello-cs316" 7 | -------------------------------------------------------------------------------- /src/Main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | main :: IO () 4 | main = do 5 | contents <- readFile "README.md" 6 | let output = unlines (reverse (lines contents)) 7 | writeFile "test.txt" output 8 | putStrLn "hello CS316!" 9 | -------------------------------------------------------------------------------- /stack.yaml.lock: -------------------------------------------------------------------------------- 1 | # This file was autogenerated by Stack. 2 | # You should not edit this file by hand. 3 | # For more information, please see the documentation at: 4 | # https://docs.haskellstack.org/en/stable/lock_files 5 | 6 | packages: [] 7 | snapshots: 8 | - completed: 9 | sha256: 7ea31a280c56bf36ff591a7397cc384d0dff622e7f9e4225b47d8980f019a0f0 10 | size: 524996 11 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/14/27.yaml 12 | original: lts-14.27 13 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Robert Atkey (c) 2020 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Robert Atkey nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -------------------------------------------------------------------------------- /CS316-Y2022.cabal: -------------------------------------------------------------------------------- 1 | name: CS316-Y2022 2 | version: 0.1.0.1 3 | -- synopsis: 4 | -- description: 5 | homepage: https://github.com/bobatkey/CS316-Y2022#readme 6 | license: BSD3 7 | license-file: LICENSE 8 | author: Robert Atkey 9 | maintainer: robert.atkey@strath.ac.uk 10 | copyright: BSD3 11 | category: Education 12 | build-type: Simple 13 | cabal-version: >=1.10 14 | extra-source-files: README.md 15 | 16 | executable hello-cs316 17 | hs-source-dirs: src 18 | main-is: Main.hs 19 | default-language: Haskell2010 20 | build-depends: base >= 4.7 && < 5 21 | 22 | library 23 | hs-source-dirs: lecture-notes 24 | exposed-modules: Week01, 25 | Week01Intro, 26 | Week01Intro02, 27 | Week01Problems, 28 | Week01Solutions, 29 | Week02, 30 | Week02Intro, 31 | Week02Problems, 32 | Week02Solutions, 33 | Week03, 34 | Week03Intro01, 35 | Week03Problems, 36 | Week03Solutions, 37 | Week04, 38 | Week04Intro, 39 | Week04Problems, 40 | Week04Solutions, 41 | Week05, 42 | Week05Intro, 43 | Week05Problems, 44 | Week05Solutions, 45 | Week06, 46 | Week06Intro, 47 | Week06Problems, 48 | Week06Solutions, 49 | Week07, 50 | Week07Intro, 51 | Week07Problems, 52 | Week07Solutions, 53 | Week08, 54 | Week08Intro, 55 | Week08Problems, 56 | Week08Solutions, 57 | Week09, 58 | Week09Intro, 59 | Week10 60 | default-language: Haskell2010 61 | build-depends: base >= 4.7 && < 5, 62 | split == 0.2.3.3, 63 | HTTP >= 4000.3.14 64 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | # This file was automatically generated by 'stack init' 2 | # 3 | # Some commonly used options have been documented as comments in this file. 4 | # For advanced use and comprehensive documentation of the format, please see: 5 | # https://docs.haskellstack.org/en/stable/yaml_configuration/ 6 | 7 | # Resolver to choose a 'specific' stackage snapshot or a compiler version. 8 | # A snapshot resolver dictates the compiler version and the set of packages 9 | # to be used for project dependencies. For example: 10 | # 11 | # resolver: lts-3.5 12 | # resolver: nightly-2015-09-21 13 | # resolver: ghc-7.10.2 14 | # 15 | # The location of a snapshot can be provided as a file or url. Stack assumes 16 | # a snapshot provided as a file might change, whereas a url resource does not. 17 | # 18 | # resolver: ./custom-snapshot.yaml 19 | # resolver: https://example.com/snapshots/2018-01-01.yaml 20 | resolver: lts-14.27 21 | 22 | # User packages to be built. 23 | # Various formats can be used as shown in the example below. 24 | # 25 | # packages: 26 | # - some-directory 27 | # - https://example.com/foo/bar/baz-0.0.2.tar.gz 28 | # subdirs: 29 | # - auto-update 30 | # - wai 31 | packages: 32 | - . 33 | # Dependency packages to be pulled from upstream that are not in the resolver. 34 | # These entries can reference officially published versions as well as 35 | # forks / in-progress versions pinned to a git hash. For example: 36 | # 37 | # extra-deps: 38 | # - acme-missiles-0.3 39 | # - git: https://github.com/commercialhaskell/stack.git 40 | # commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a 41 | # 42 | # extra-deps: [] 43 | 44 | # Override default flag values for local packages and extra-deps 45 | # flags: {} 46 | 47 | # Extra package databases containing global packages 48 | # extra-package-dbs: [] 49 | 50 | # Control whether we use the GHC we find on the path 51 | # system-ghc: true 52 | # 53 | # Require a specific version of stack, using version ranges 54 | # require-stack-version: -any # Default 55 | # require-stack-version: ">=2.3" 56 | # 57 | # Override the architecture used by stack, especially useful on Windows 58 | # arch: i386 59 | # arch: x86_64 60 | # 61 | # Extra directories used by stack for building 62 | # extra-include-dirs: [/path/to/dir] 63 | # extra-lib-dirs: [/path/to/dir] 64 | # 65 | # Allow a newer minor version of GHC than the snapshot specifies 66 | # compiler-check: newer-minor 67 | -------------------------------------------------------------------------------- /lecture-notes/Week07Problems.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE InstanceSigs #-} 2 | {-# LANGUAGE RebindableSyntax #-} 3 | {-# OPTIONS_GHC -fwarn-incomplete-patterns #-} 4 | module Week07Problems where 5 | 6 | import Prelude hiding ( Monad (..) 7 | , Applicative (..) 8 | , mapM 9 | , mapM_ 10 | , (<$>)) 11 | import Week07 hiding (search, lookupAll, ifThenElse, (>>)) 12 | 13 | {- This is needed due to the RebindableSyntax extension. I'm using this 14 | extension so the 'do' notation in this file uses my redefined 15 | 'Monad' type class, not the standard library one. RebindableSyntax 16 | lets the user redefine what 'do', and 'if' mean. I've given 'if' 17 | the standard meaning here: -} 18 | ifThenElse True x y = x 19 | ifThenElse False x y = y 20 | (>>) x y = x >>= \_ -> y 21 | 22 | {------------------------------------------------------------------------------} 23 | {- TUTORIAL QUESTIONS -} 24 | {------------------------------------------------------------------------------} 25 | 26 | {- 1. The 'Maybe' monad is useful for simulating exceptions. But when an 27 | exception is thrown, we don't get any information on what the 28 | exceptional condition was! The way to fix this is to use a type 29 | that includes some information on the 'Error' case: -} 30 | 31 | data Result a 32 | = Ok a 33 | | Error String 34 | deriving Show 35 | 36 | {- Write a Monad instance for 'Result', using the code from your 37 | 'returnOk' and 'ifOK' functions from last week, and then use it 38 | to rewrite the 'search' and 'lookupAll' functions. -} 39 | 40 | 41 | {- 2. Write a function using the Printing monad and 'do' notation that 42 | "prints out" all the strings in a tree of 'String's: -} 43 | 44 | printTree :: Tree String -> Printing () 45 | printTree = undefined 46 | 47 | 48 | {- 3. The implementation of 'sumImp' in the notes can only sum up lists 49 | of 'Int's. 50 | 51 | (a) What changes would you have to make to 'State' so that you 52 | can add up lists of 'Double's? You'll have to make a new 53 | newtype like 'State', and reimplement the 'runState', the 54 | 'Monad' instance, the 'get' and 'put' function, and finally 55 | the 'sumpImp' function. The changes to the actual code will 56 | be minimal, if anything. All the changes are in the types. -} 57 | 58 | 59 | 60 | 61 | {- (b) Make an alternative version of 'State' that is parameterised 62 | by the type of the state (so that someone using it can 63 | decide whether it is 'Int' or 'Double' for instance). -} 64 | 65 | 66 | {- 4. Write a function like mapM that works on 'Tree's instead of lists: -} 67 | 68 | mapTreeM :: Monad m => (a -> m b) -> Tree a -> m (Tree b) 69 | mapTreeM = undefined 70 | 71 | 72 | {- 5. Write a function like mapM that works on 'Maybe's instead of lists: -} 73 | 74 | mapMaybeM :: Monad m => (a -> m b) -> Maybe a -> m (Maybe b) 75 | mapMaybeM = undefined 76 | -------------------------------------------------------------------------------- /lecture-notes/Week01Intro02.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -fwarn-incomplete-patterns #-} 2 | 3 | module Week01Intro02 where 4 | 5 | -- Recap 6 | 7 | --- 1. Data (with types) 8 | --- 2. Functions, defined by Pattern Matching 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | -- Today: defining functions by recursion 17 | 18 | 19 | 20 | 21 | 22 | --- Example 1: factorial 23 | 24 | -- factorial 6 = 6 * 5 * 4 * 3 * 2 * 1 25 | -- = 6 * factorial 5 26 | 27 | factorial :: Integer -> Integer 28 | factorial 0 = 1 29 | factorial 1 = 1 30 | factorial n = n * factorial (n-1) 31 | 32 | -- factorial 6 = 6 * factorial (6-1) 33 | -- = 6 * factorial 5 34 | -- = 6 * (5 * factorial (5-1)) 35 | -- = .. 36 | -- = 6 * (5 * (4 * (3 * (2 * factorial 1)))) 37 | -- = 6 * (5 * (4 * (3 * (2 * 1)))) 38 | -- = 720 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | --- Example 2: Recursive types 47 | 48 | {- 49 | data ListofCards 50 | = NoCards 51 | | OneCard Card 52 | | TwoCards Card Card 53 | | ThreeCards Card Card Card 54 | -} 55 | 56 | data ListOfInts 57 | = NoInts 58 | | ConsInt Int ListOfInts 59 | deriving Show 60 | 61 | 62 | ---- Sum of a list of integers 63 | 64 | sumListOfInts :: ListOfInts -> Int 65 | sumListOfInts NoInts = 0 66 | sumListOfInts (ConsInt x xs) = x + sumListOfInts xs 67 | 68 | -- sumListOfInts (ConsInt 12 (ConsInt 76 NoInts)) 69 | -- = 12 + sumListOfInts (ConsInt 76 NoInts) 70 | -- = 12 + (76 + sumListOfInts NoInts) 71 | -- = 12 + (76 + 0) 72 | -- = 88 73 | 74 | 75 | ---- List a 76 | data List a 77 | = Nil 78 | | Cons a (List a) --- Int ListOfInts 79 | deriving Show 80 | 81 | -- abstraction: 82 | -- double x = 2 * x 83 | --- 84 | -- multiply n x = n * x 85 | 86 | 87 | ---- Sum of a list of integers 88 | sumList :: List Int -> Int 89 | sumList Nil = 0 90 | sumList (Cons x xs) = x + sumList xs 91 | 92 | ---- Product of a list of integers 93 | productList :: List Int -> Int 94 | productList Nil = 1 95 | productList (Cons x xs) = x * productList xs 96 | 97 | ---- Making Lists 98 | range :: Int -> List Int 99 | range 0 = Nil 100 | range n = if n < 0 then Cons n (range (n+1)) else Cons n (range (n-1)) 101 | 102 | -- range 5 = Cons 5 (Cons 4 (Cons 3 (Cons 2 (Cons 1 Nil)))) 103 | 104 | 105 | ---- Factorial by combing product and 'range' 106 | factorial_v2 :: Int -> Int 107 | factorial_v2 n = result 108 | where numbersFromN = range n 109 | result = productList numbersFromN 110 | 111 | ---- Actual lists 112 | -- data [a] 113 | -- = [] -- Nil 114 | -- | a : [a] -- Cons a (List a) 115 | 116 | ---- Search and replace in strings 117 | -- type String = [Char] 118 | 119 | -- A function to capitalise all 'e's in a String: 120 | 121 | capitaliseEs :: String -> String 122 | -- [Char] -> [Char] 123 | capitaliseEs "" = "" 124 | capitaliseEs (c:cs) = if c == 'e' then 'E' : capitaliseEs cs else c : capitaliseEs cs 125 | 126 | -- capitaliseEs ('e':cs) = 'E' : capitaliseEs cs 127 | -- capitaliseEs (c:cs) = c : capitaliseEs cs 128 | -------------------------------------------------------------------------------- /lecture-notes/Week08Problems.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE InstanceSigs #-} 2 | module Week08Problems where 3 | 4 | import System.IO (Handle, openFile, IOMode (WriteMode), hClose, hPutChar) 5 | import GHC.IO (finally) 6 | import Data.Foldable (for_) 7 | import Week08 8 | import Data.List (intercalate) 9 | import Data.Char (isAlphaNum) 10 | 11 | {------------------------------------------------------------------------------} 12 | {- TUTORIAL QUESTIONS -} 13 | {------------------------------------------------------------------------------} 14 | 15 | {- 1. (a) Write a function 'withOutputFile' that does what 'withInputFile' 16 | (section 8.3) does but for output. -} 17 | 18 | withOutputFile :: FilePath -> (Handle -> IO a) -> IO a 19 | withOutputFile = undefined 20 | 21 | {- (b) Use your 'withOutputFile' to write an exception safe version 22 | of 'writeToFile'. -} 23 | 24 | writeFile :: FilePath -> String -> IO () 25 | writeFile = undefined 26 | 27 | 28 | {- 2. Write a parser for primary colours, similar to the 'parseBool' 29 | function from the notes. Here is the PrimaryColour type: -} 30 | 31 | data PrimaryColour 32 | = Red 33 | | Green 34 | | Blue 35 | deriving (Show, Eq) 36 | 37 | parsePrimaryColour :: Parser PrimaryColour 38 | parsePrimaryColour = undefined 39 | 40 | {- For example, 41 | 42 | > runParser parsePrimaryColour "Red" 43 | Just ("", Red) 44 | > runParser parsePrimaryColour "Green" 45 | Just ("", Green) 46 | > runParser parsePrimaryColour "Blue" 47 | Just ("", Blue) 48 | > runParser parsePrimaryColour "Purple" 49 | Nothing 50 | -} 51 | 52 | {- 3. Use 'sepBy', 'isString' and 'parsePrimaryColour' to write a parser 53 | for comma separated lists of primary colours. -} 54 | 55 | parseListOfPrimaryColours :: Parser [PrimaryColour] 56 | parseListOfPrimaryColours = undefined 57 | 58 | {- 4. Let us now make a little programming language. Expressions in this 59 | language follow Java-/C-style function use syntax. For example: 60 | 61 | f(4,5) is AppExp "f" [IntExp 4, IntExp 5] 62 | 63 | f(g(3),5) is AppExp "f" [AppExp "g" [IntExp 3], IntExp 5] 64 | 65 | The grammar is: 66 | 67 | ::= 68 | | '(' ')' 69 | | '(' (',' )* ')' 70 | 71 | That is, an is either: 72 | 73 | (a) an integer 74 | (b) an identifier (word without spaces) followed by "()"; or 75 | (c) an identifier followed by '(', then an , then zero or more commas and s, then a ')' 76 | 77 | Here is the datatype for expressions in this language: -} 78 | 79 | data Expr 80 | = IntExp Int 81 | | AppExp String [Expr] 82 | deriving Show 83 | 84 | {- The following function prints out 'Expr's in the Java-/C-style 85 | syntax: -} 86 | 87 | printExpr :: Expr -> String 88 | printExpr (IntExp i) = show i 89 | printExpr (AppExp funNm args) = 90 | funNm ++ "(" ++ intercalate "," (map printExpr args) ++ ")" 91 | 92 | 93 | {- Your task is to write a parser for 'Expr's. This will similar to 94 | the general structure of the JSON parser in the notes. Have a 95 | section of the parser for each constructor ('IntExp' and 96 | 'AppExp'), and use the grammar above as a guide. Use the 97 | 'number' parser from the notes to parse numbers. The 98 | 'parseIdentifier' parser defined below will be useful for doing 99 | the function names. -} 100 | 101 | parseExpr :: Parser Expr 102 | parseExpr = undefined 103 | 104 | 105 | parseIdentifier :: Parser String 106 | parseIdentifier = 107 | do c <- parseIdentifierChar 108 | cs <- zeroOrMore parseIdentifierChar 109 | return (c:cs) 110 | where 111 | parseIdentifierChar = 112 | do c <- char 113 | if isAlphaNum c then return c else failParse 114 | -------------------------------------------------------------------------------- /lecture-notes/Week03Intro01.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -fwarn-incomplete-patterns #-} 2 | module Week03Intro01 where 3 | 4 | {- WEEK 3 : HIGHER ORDER FUNCTIONS 5 | 6 | myFunc = lambda x: x*x -- Python 7 | 8 | x => x*x -- Javascript 9 | 10 | x -> x*x -- Java 11 | 12 | \x -> x*x -- Haskell 13 | -} 14 | 15 | 16 | 17 | 18 | {- FUNCTIONS THAT RETURN FUNCTIONS -} 19 | 20 | add :: Int -> (Int -> Int) 21 | add x y = x + y 22 | 23 | addTen :: Int -> Int 24 | addTen = add 10 25 | 26 | -- Lambda notation 27 | add0 :: Int -> (Int -> Int) 28 | add0 = \x -> (\y -> x + y) 29 | 30 | -- add0 5 31 | -- = (\x -> (\y -> x + y)) 5 32 | -- = (\y -> 5 + y) 33 | 34 | -- add0 5 6 35 | -- = (\x -> (\y -> x + y)) 5 6 36 | -- = (\y -> 5 + y) 6 37 | -- = 5 + 6 38 | -- = 11 39 | 40 | 41 | -- Partial application 42 | tag :: String -> String -> String 43 | tag tagname body = "<" ++ tagname ++ ">" ++ body ++ "" 44 | 45 | p, strong, em, div :: String -> String 46 | p = tag "p" 47 | strong = tag "strong" 48 | em = tag "em" 49 | div = tag "div" 50 | 51 | helloworld tagName = tag tagName "Hello world" 52 | 53 | flip_v2 :: (a -> b -> c) -> b -> a -> c 54 | flip_v2 f b a = f a b 55 | 56 | helloworld_v2 = flip tag "hello world" 57 | -- = \a -> tag a "hello world" 58 | 59 | {- FUNCTIONS THAT TAKE FUNCTIONS AS ARGUMENTS -} 60 | 61 | ten :: Int 62 | ten = add 5 5 63 | 64 | double :: Int -> Int 65 | double x = add x x 66 | 67 | -- applyCopy :: (Int -> Int -> Int) -> Int -> Int 68 | applyCopy :: (t1 -> t1 -> t2) -> t1 -> t2 69 | applyCopy f x = f x x 70 | 71 | -- applyCopy add 5 72 | -- = add 5 5 73 | -- = 5 + 5 74 | -- = 10 75 | 76 | double_v2 :: Int -> Int 77 | double_v2 = applyCopy add 78 | 79 | square :: Int -> Int 80 | square = applyCopy (\x -> \y -> x * y) 81 | -- = \x -> (\x -> \y -> x * y) x x 82 | -- = \x -> (\y -> x * y) x 83 | -- = \x -> x * x 84 | 85 | {- MAP and FILTER -} 86 | 87 | doubleList :: [Int] -> [Int] 88 | doubleList [] = [] 89 | doubleList (x:xs) = (x * 2) : doubleList xs 90 | 91 | incrementList :: [Int] -> [Int] 92 | incrementList [] = [] 93 | incrementList (x:xs) = (x + 1) : incrementList xs 94 | 95 | -- These two functions generalised: 96 | 97 | -- myMap :: (Int -> Int) -> [Int] -> [Int] 98 | myMap :: (a -> b) -> [a] -> [b] 99 | myMap f [] = [] 100 | myMap f (x:xs) = f x : myMap f xs 101 | 102 | -- In the Haskell standard library as 'map' 103 | 104 | -- Write a function that duplicates every element of a list 105 | -- dupAll [1,2,3] == [1,1,2,2,3,3] 106 | -- write your function using map and concat. 107 | 108 | -- [1, 2, 3 ] 109 | -- | | | 110 | -- v v v 111 | -- [[1,1],[2,2],[3,3]] 112 | 113 | dupAll :: [a] -> [a] 114 | dupAll xs = concat (map (\x -> [x,x]) xs) 115 | 116 | -- WHY NOT: dupAll2 [] = [] 117 | -- dupAll2 (x:xs) = x : x : dupAll2 xs 118 | -- 119 | --- This works, but (a) you have to think about the recursion and what is happening to each element at the same time 120 | -- (b) it doesn't demonstrate the 'bulk' nature of the 'map' operation 121 | 122 | ----- FILTERING 123 | 124 | elementsLessThan5 :: [Int] -> [Int] 125 | elementsLessThan5 [] = [] 126 | elementsLessThan5 (x:xs) = if x < 5 then x : elementsLessThan5 xs else elementsLessThan5 xs 127 | 128 | myFilter :: (a -> Bool) -> [a] -> [a] 129 | myFilter f [] = [] 130 | myFilter f (x:xs) = if f x then x : myFilter f xs else myFilter f xs 131 | 132 | -- In the Haskell standard library as 'filter' 133 | 134 | -- FROM table 135 | -- WHERE condition 136 | -- SELECT a * 2, b, c 137 | 138 | db :: [(String,String)] 139 | db = [("Alice", "A Christmas Carol"), 140 | ("Bob", "Tinker Tailor Soldier Spy"), 141 | ("Carol", "Alice in Wonderland")] 142 | 143 | query = map (\(name, booktitle) -> booktitle) 144 | (filter (\(name, booktitle) -> length name > 3) 145 | db) 146 | 147 | mapFilter selection condition db = map selection (filter condition db) 148 | -------------------------------------------------------------------------------- /lecture-notes/Week07Intro.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE InstanceSigs #-} 2 | {-# LANGUAGE RebindableSyntax #-} 3 | {-# OPTIONS_GHC -fwarn-incomplete-patterns #-} 4 | module Week07Intro where 5 | 6 | import Prelude hiding ( Monad (..) 7 | , Applicative (..) 8 | , mapM 9 | , mapM_ 10 | , (<$>)) 11 | import Data.Char (isDigit, digitToInt) 12 | 13 | {- This is needed due to the RebindableSyntax extension. I'm using this 14 | extension so the 'do' notation in this file uses my redefined 15 | 'Monad' type class, not the standard library one. RebindableSyntax 16 | lets the user redefine what 'do', and 'if' mean. I've given 'if' 17 | the standard meaning here: -} 18 | ifThenElse True x y = x 19 | ifThenElse False x y = y 20 | (>>) x y = x >>= \_ -> y 21 | 22 | 23 | 24 | {------------------------------------------------------------------------------} 25 | {- Week 07 : MONADS -} 26 | {------------------------------------------------------------------------------} 27 | 28 | {- 7.1 WHAT IS A MONAD and THE MAYBE MONAD -} 29 | 30 | -- Examples 31 | 32 | -- f :: Int -> Int --- does nothing but take an Int and return an Int (or not terminate) 33 | 34 | -- f :: Int -> Maybe Int -- this *may* throw an exception 35 | -- f :: Int -> State Int -- this *may* update some state 36 | -- f :: Int -> Printing Int -- this *may* do some printing 37 | -- f :: Int -> Process Int -- this *may* so some I/O 38 | 39 | -- ifOK :: Maybe a -> (a -> Maybe b) -> Maybe b 40 | -- andThen :: State a -> (a -> State b) -> State b 41 | -- sequ :: Process a -> (a -> Process b) -> Process b 42 | 43 | -- returnOk :: a -> Maybe a 44 | -- returnSt :: a -> State a 45 | -- returnProc :: a -> Process a 46 | 47 | class Monad m where 48 | return :: a -> m a 49 | (>>=) :: m a -> (a -> m b) -> m b -- pronounced 'bind' 50 | 51 | instance Monad Maybe where 52 | -- This is the same as 'returnOk' from last week 53 | return x = Just x 54 | 55 | -- This is the same as 'ifOK' from last week 56 | (>>=) Nothing k = Nothing 57 | (>>=) (Just a) k = k a 58 | 59 | -- search 60 | 61 | search :: Eq k => k -> [(k,v)] -> Maybe v 62 | search k [] = Nothing 63 | search k ((k',v'):kvs) = if k == k' then return v' else search k kvs 64 | 65 | lookupAll :: Eq k => [k] -> [(k,v)] -> Maybe [v] 66 | lookupAll [] kvs = return [] 67 | lookupAll (k:ks) kvs = 68 | search k kvs >>= \v -> 69 | lookupAll ks kvs >>= \vs -> 70 | return (v:vs) 71 | 72 | 73 | {- 7.2 'do' NOTATION -} 74 | 75 | -- this function is exactly the same as the previous 'lookupAll' 76 | lookupAll_v2 :: Eq k => [k] -> [(k,v)] -> Maybe [v] 77 | lookupAll_v2 [] kvs = return [] 78 | lookupAll_v2 (k:ks) kvs = 79 | do v <- search k kvs 80 | vs <- lookupAll_v2 ks kvs 81 | return (v:vs) 82 | 83 | 84 | {- 7.4 STATE MONAD -} 85 | 86 | data State a = MkState (Int -> (Int, a)) 87 | 88 | instance Monad State where 89 | return a = MkState (\s -> (s, a)) 90 | 91 | (>>=) (MkState f) k = 92 | MkState (\s0 -> let (s1, a) = f s0 93 | MkState g = k a 94 | (s2, b) = g s1 95 | in (s2, b)) 96 | 97 | get :: State Int 98 | get = MkState (\s -> (s,s)) 99 | 100 | put :: Int -> State () 101 | put i = MkState (\_ -> (i, ())) 102 | 103 | numberList :: [a] -> State [(a,Int)] 104 | numberList [] = return [] 105 | numberList (x:xs) = 106 | do i <- get; put (i+1); ys <- numberList xs; return ((x,i) : ys) 107 | 108 | -- "Overloaded semicolon" 109 | 110 | runState :: State a -> Int -> a 111 | runState (MkState f) s = case f s of (_, a) -> a 112 | 113 | 114 | 115 | {- 7.5 FUNCTIONS FOR ALL MONADS -} 116 | 117 | mapM :: Monad m => (a -> m b) -> [a] -> m [b] 118 | mapM f [] = return [] 119 | mapM f (x:xs) = 120 | do y <- f x 121 | ys <- mapM f xs 122 | return (y:ys) 123 | 124 | -- forM 125 | 126 | forM :: Monad m => [a] -> (a -> m b) -> m [b] 127 | forM xs f = mapM f xs 128 | 129 | lookupAll_v3 :: Eq k => [k] -> [(k,v)] -> Maybe [v] 130 | lookupAll_v3 ks kvs = 131 | forM ks (\k -> 132 | search k kvs) 133 | 134 | numberList_v2 :: [a] -> State [(a,Int)] 135 | numberList_v2 xs = 136 | forM xs (\x -> do i <- get 137 | put (i+1) 138 | return (x,i)) 139 | 140 | -- lookupAll, again 141 | -------------------------------------------------------------------------------- /lecture-notes/Week02Intro.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -fwarn-incomplete-patterns #-} 2 | module Week02Intro where 3 | 4 | import Prelude hiding (Maybe, Nothing, Just) 5 | 6 | {- Week 02; Lecture 03 7 | 8 | 9 | MAKING DECISIONS and DEALING WITH FAILURE 10 | 11 | -} 12 | 13 | 14 | 15 | 16 | 17 | -- isMember; using if-then-else 18 | isMember :: Eq a 19 | => a -> [a] -> Bool 20 | isMember y [] = False 21 | isMember y (x:xs) = if x == y then True else isMember y xs 22 | -- y :: a 23 | -- x :: a 24 | -- xs :: [a] 25 | 26 | -- We can't repeat the 'y' twice in the pattern to stand for equality 27 | 28 | -- isMember2; using guards 29 | isMember2 :: Eq a 30 | => a -> [a] -> Bool 31 | isMember2 y [] = False 32 | isMember2 y (x:xs) 33 | | x == y = True 34 | -- | x /= y = isMember2 y xs --- this by itself is not enough to guarantee completeness 35 | | otherwise = isMember2 y xs 36 | 37 | isMember3 :: Eq a => a -> [a] -> Bool 38 | isMember3 y [] = False 39 | isMember3 y (x:xs) = (x == y) || isMember3 y xs 40 | 41 | -- isMember4; using case 42 | isMember4 :: Eq a => a -> [a] -> Bool 43 | isMember4 y [] = False 44 | isMember4 y (x:xs) = 45 | case x == y of 46 | True -> True 47 | False -> isMember y xs 48 | {- 49 | case x - y of 50 | 0 -> True 51 | 1 -> True 52 | _ -> isMember y xs 53 | -} 54 | 55 | isMember5 :: Ord a => a -> [a] -> Bool 56 | isMember5 y [] = False 57 | isMember5 y (x:xs) = 58 | case compare x y of 59 | EQ -> True 60 | LT -> isMember5 y xs 61 | GT -> isMember5 y xs 62 | 63 | -- Trees 64 | data Tree a 65 | = Leaf 66 | | Node (Tree a) a (Tree a) 67 | deriving Show 68 | 69 | {- 1 70 | / \ 71 | 2 L 72 | /\ 73 | L L 74 | -} 75 | 76 | example = Node (Node Leaf 2 Leaf) 1 Leaf 77 | 78 | sortedExample = Node Leaf 1 (Node Leaf 2 Leaf) 79 | 80 | isTreeMember :: Ord a => a -> Tree a -> Bool 81 | isTreeMember y (Node l x r) = 82 | {- 83 | if x == y then 84 | True 85 | else if y < x then 86 | isTreeMember y l 87 | else 88 | isTreeMember y r 89 | -} 90 | case compare y x of 91 | EQ -> True 92 | LT -> isTreeMember y l 93 | GT -> isTreeMember y r 94 | isTreeMember y Leaf = False 95 | 96 | 97 | -- Maybe 98 | data Maybe a 99 | = Nothing 100 | | Just a 101 | deriving Show 102 | 103 | exampleKV :: Tree (String,Int) 104 | exampleKV = Node (Node Leaf ("a",1) Leaf) ("b",2) Leaf 105 | 106 | -- getKey 107 | -- Optional getKey(A a, Tree t) throws KeyNotFound 108 | 109 | getKey :: Ord a => a -> Tree (a,b) -> Maybe b 110 | getKey k Leaf = Nothing 111 | getKey k (Node l (k', v) r) = 112 | case compare k k' of 113 | EQ -> Just v 114 | LT -> getKey k l 115 | GT -> getKey k r 116 | 117 | 118 | -- dealing with Failure: reading a list of keys from a tree 119 | getKeys :: Ord a => [a] -> Tree (a,b) -> Maybe [b] 120 | getKeys [] tree = Just [] 121 | getKeys (k:ks) tree = 122 | case getKey k tree of 123 | Nothing -> Nothing 124 | Just v -> 125 | case getKeys ks tree of 126 | Nothing -> Nothing 127 | Just vs -> 128 | Just (v:vs) 129 | 130 | getKeys0 :: Ord a => [a] -> Tree (a,b) -> [Maybe b] 131 | getKeys0 [] tree = [] 132 | getKeys0 (k:ks) tree = getKey k tree : getKeys0 ks tree 133 | 134 | -- getKeys ks tree = catMaybes (getKeys0 ks tree) 135 | 136 | catMaybes0 :: [Maybe a] -> Maybe [a] 137 | catMaybes0 list = if isThereANothing list then Nothing else Just (extractJusts list) 138 | 139 | extractJusts :: [Maybe a] -> [a] 140 | extractJusts [] = [] 141 | extractJusts (Just x:xs) = x : extractJusts xs 142 | extractJusts (Nothing:xs) = extractJusts xs 143 | 144 | isThereANothing :: [Maybe a] -> Bool 145 | isThereANothing [] = False 146 | isThereANothing (Nothing : _) = True 147 | isThereANothing (Just _ : xs) = isThereANothing xs 148 | 149 | catMaybes :: [Maybe a] -> Maybe [a] 150 | catMaybes [] = Just [] 151 | catMaybes (Nothing:_) = Nothing 152 | catMaybes (Just x:xs) = 153 | case catMaybes xs of 154 | Nothing -> Nothing 155 | Just ys -> Just (x:ys) 156 | 157 | -- catMaybes [Just 1, Just 2, Just 3] == Just [1,2,3] 158 | -- catMaybes [Nothing, Just 1, Just 2] == Nothing 159 | -- catMaybes [Just 1, Nothing, Just 2] == Nothing 160 | 161 | {- if (itIsSafe) { 162 | // 163 | 164 | do thing that might fail 165 | } 166 | -} 167 | 168 | {- 169 | getKeys list tree = 170 | case list of 171 | [] -> 172 | Just [] 173 | (k:ks) -> 174 | -- as above 175 | -} 176 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # CS316 “Functional Programming” 2 | 3 | Welcome to the source code repository for the University of Strathclyde CS316 “Functional Programming” course. 4 | 5 | This is a course designed to teach Haskell to undergraduate students. The written course materials are available from this repository. Video lectures and access to the Mattermost forum for this course are available to Strathclyde students via the course's [MyPlace page](https://classes.myplace.strath.ac.uk/course/view.php?id=15897). 6 | 7 | ## Getting started 8 | 9 | The code in this repository is structured as a [Stack](https://docs.haskellstack.org/en/stable/README/) project. You can install Stack by following the instructions on the linked page. 10 | 11 | ### VSCode 12 | 13 | The recommended text editor is Microsoft's Visual Studio Code. This has a nice Haskell extension that will do syntax highlighting, type checking and autocomplete for you. It also comes with a built-in Git implemenation, so you don't have to install that separately. I have prepared a short video that shows how to set up VS Code once you have it and Stack installed: [CS316 : Getting started with VSCode (03:22)](https://web.microsoftstream.com/video/782a862c-92ee-458f-951e-d7b59a1f9e44) (Strathclyde students only). 14 | 15 | ### By hand 16 | 17 | If you don't want to use VSCode, or want to know what is going on behind the curtain, then you can clone and build the repository yourself. Here are the commands that you would type in on a Unix-like machine: 18 | 19 | ``` 20 | $ cd some/nice/directory # replace 'some/nice/directory' with a real one 21 | $ git clone https://github.com/bobatkey/CS316-2022.git 22 | $ cd CS316-2022 23 | $ stack build 24 | ... lots of output, might download some things ... 25 | $ stack exec hello-cs316 26 | hello CS316! 27 | $ stack ghci lecture-notes/Week01.hs 28 | ... will start the interactive Haskell compiler with Week 1's lecture notes loaded ... 29 | ``` 30 | 31 | ## Syllabus and Lecture Notes 32 | 33 | The lecture notes for this course are intended to accompany the video lectures, and provide mostly the same information in a searchable, accessible and less bandwidth hungry format. 34 | 35 | The notes are Haskell files with interleaved code and commentary. You are encouraged to experiment by loading these files into `ghci` and editing them. Each week also has a set of tutorial questions that you should have a go at before the tutorial sessions on Fridays. The solutions will be released after the session. 36 | 37 | - [Week 1](lecture-notes/Week01.hs) : Data and Functions 38 | - [Tutorial Problems](lecture-notes/Week01Problems.hs) 39 | - [Tutorial Solutions](lecture-notes/Week01Solutions) 40 | - [Live Lecture notes (Tuesday)](lecture-notes/Week01Intro.hs) 41 | - [Live Lecture notes (Friday)](lecture-notes/Week01Intro02.hs) 42 | - [Week 2](lecture-notes/Week02.hs) : Solving Problems by Recusion 43 | - [Tutorial Problems](lecture-notes/Week02Problems.hs) 44 | - [Tutorial Solutions](lecture-notes/Week02Solution.hs) 45 | - [Live Lecture Notes (Friday)](lecture-notes/Week02Intro.hs). 46 | - [Week 3](lecture-notes/Week03.hs) : Higher Order Functions 47 | - [Tutorial Problems](lecture-notes/Week03Problems.hs) 48 | - [Tutorial Solutions](lecture-notes/Week03Solutions.hs) 49 | - [Live Lecture Notes](lecture-notes/Week03Intro01.hs) 50 | - [Week 4](lecture-notes/Week04.hs) : Patterns of Recursion 51 | - [Tutorial Problems](lecture-notes/Week04Problems.hs) 52 | - [Tutorial Solutions](lecture-notes/Week04Solutions.hs) 53 | - [Live Lecture Notes (Tuesday)](lecture-notes/Week04Intro.hs) 54 | - [Week 5](lecture-notes/Week05.hs) : Classes of Types 55 | - [Tutorial Problems](lecture-notes/Week05Problems.hs) 56 | - [Tutorial Solutions](lecture-notes/Week05Solutions.hs) 57 | - [Live Lecture Notes](lecture-notes/Week05Intro.hs) 58 | - [Week 6](lecture-notes/Week06.hs) : Simulating side-effects: Exceptions, State, and Printing 59 | - [Tutorial Problems](lecture-notes/Week06Problems.hs) 60 | - [Tutorial Solutions](lecture-notes/Week06Solutions.hs) 61 | - [Live Lecture Notes](lecture-notes/Week06Intro.hs) 62 | - [Week 7](lecture-notes/Week07.hs) : Monads 63 | - [Tutorial Problems](lecture-notes/Week07Problems.hs) 64 | - [Tutorial Solutions](lecture-notes/Week07Solutions.hs) 65 | - [Live Lecture Notes](lecture-notes/Week07Intro.hs) 66 | - [Week 8](lecture-notes/Week08.hs) : Real I/O and Parser Combinators 67 | - [Tutorial Problems](lecture-notes/Week08Problems.hs) 68 | - [Tutorial Solutions](lecture-notes/Week08Solutions.hs) 69 | - [Live Lecture Notes](lecture-notes/Week08Intro.hs) 70 | - [Week 9](lecture-notes/Week09.hs) : Data Dependencies and Applicative Functors 71 | - [Live Lecture Notes](lecture-notes/Week09Intro.hs) 72 | - [Week 10](lecture-notes/Week10.hs) : Lazy Evaluation and Infinite Data 73 | 74 | You can take a look at [last year's repository](https://github.com/bobatkey/CS316-2021) and [the one before that](https://github.com/bobatkey/CS316-2020) for similar notes and some different exercises. 75 | -------------------------------------------------------------------------------- /lecture-notes/Week08Solutions.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE InstanceSigs #-} 2 | module Week08Solutions where 3 | 4 | import System.IO (Handle, openFile, IOMode (WriteMode), hClose, hPutChar) 5 | import GHC.IO (finally) 6 | import Data.Foldable (for_) 7 | import Week08 8 | import Data.List (intercalate) 9 | import Data.Char (isAlphaNum) 10 | 11 | {------------------------------------------------------------------------------} 12 | {- TUTORIAL QUESTIONS -} 13 | {------------------------------------------------------------------------------} 14 | 15 | {- 1. (a) Write a function 'withOutputFile' that does what 'withInputFile' 16 | (section 8.3) does but for output. -} 17 | 18 | -- The only difference is that the call to 'openFile' uses 'WriteMode' 19 | -- instead of 'ReadMode'. 20 | 21 | withOutputFile :: FilePath -> (Handle -> IO a) -> IO a 22 | withOutputFile path body = 23 | do handle <- openFile path WriteMode 24 | result <- body handle `finally` hClose handle 25 | return result 26 | 27 | {- (b) Use your 'withOutputFile' to write an exception safe version 28 | of 'writeToFile'. -} 29 | 30 | writeFile :: FilePath -> String -> IO () 31 | writeFile path content = 32 | withOutputFile path $ \handle -> 33 | for_ content (hPutChar handle) 34 | 35 | 36 | {- 2. Write a parser for primary colours, similar to the 'parseBool' 37 | function from the notes. Here is the PrimaryColour type: -} 38 | 39 | data PrimaryColour 40 | = Red 41 | | Green 42 | | Blue 43 | deriving (Show, Eq) 44 | 45 | -- This is (I think) the clearest way to write this parser. Using 46 | -- 'isString' avoids too many low-level operations involving 47 | -- individual characters. 48 | 49 | parsePrimaryColour :: Parser PrimaryColour 50 | parsePrimaryColour = 51 | do isString "Red" 52 | return Red 53 | `orElse` 54 | do isString "Green" 55 | return Green 56 | `orElse` 57 | do isString "Blue" 58 | return Blue 59 | 60 | {- For example, 61 | 62 | > runParser parsePrimaryColour "Red" 63 | Just ("", Red) 64 | > runParser parsePrimaryColour "Green" 65 | Just ("", Green) 66 | > runParser parsePrimaryColour "Blue" 67 | Just ("", Blue) 68 | > runParser parsePrimaryColour "Purple" 69 | Nothing 70 | -} 71 | 72 | {- 3. Use 'sepBy', 'isString' and 'parsePrimaryColour' to write a parser 73 | for comma separated lists of primary colours. -} 74 | 75 | parseListOfPrimaryColours :: Parser [PrimaryColour] 76 | parseListOfPrimaryColours = sepBy (isString ",") parsePrimaryColour 77 | 78 | -- You could also do: 79 | -- 80 | -- parseListOfPrimaryColours = parseList parsePrimaryColour 81 | -- 82 | -- to parse Haskell-style lists that are surrounded by '[' and ']'. 83 | 84 | 85 | {- 4. Let us now make a little programming language. Expressions in this 86 | language follow Java-/C-style function use syntax. For example: 87 | 88 | f(4,5) is AppExp "f" [IntExp 4, IntExp 5] 89 | 90 | f(g(3),5) is AppExp "f" [AppExp "g" [IntExp 3], IntExp 5] 91 | 92 | The grammar is: 93 | 94 | ::= 95 | | '(' ')' 96 | | '(' (',' )* ')' 97 | 98 | That is, an is either: 99 | 100 | (a) an integer 101 | (b) an identifier (word without spaces) followed by "()"; or 102 | (c) an identifier followed by '(', then an , then zero or more commas and s, then a ')' 103 | 104 | Here is the datatype for expressions in this language: -} 105 | 106 | data Expr 107 | = IntExp Int 108 | | AppExp String [Expr] 109 | deriving Show 110 | 111 | {- The following function prints out 'Expr's in the Java-/C-style 112 | syntax: -} 113 | 114 | printExpr :: Expr -> String 115 | printExpr (IntExp i) = show i 116 | printExpr (AppExp funNm args) = 117 | funNm ++ "(" ++ intercalate "," (map printExpr args) ++ ")" 118 | 119 | 120 | {- Your task is to write a parser for 'Expr's. This will similar to 121 | the general structure of the JSON parser in the notes. Have a 122 | section of the parser for each constructor ('IntExp' and 123 | 'AppExp'), and use the grammar above as a guide. Use the 124 | 'number' parser from the notes to parse numbers. The 125 | 'parseIdentifier' parser defined below will be useful for doing 126 | the function names. -} 127 | 128 | parseExpr :: Parser Expr 129 | parseExpr = 130 | do n <- number 131 | return (IntExp n) 132 | `orElse` 133 | do funNm <- parseIdentifier 134 | isChar '(' 135 | args <- sepBy (isChar ',') parseExpr 136 | isChar ')' 137 | return (AppExp funNm args) 138 | 139 | 140 | parseIdentifier :: Parser String 141 | parseIdentifier = 142 | do c <- parseIdentifierChar 143 | cs <- zeroOrMore parseIdentifierChar 144 | return (c:cs) 145 | where 146 | parseIdentifierChar = 147 | do c <- char 148 | if isAlphaNum c then return c else failParse 149 | -------------------------------------------------------------------------------- /lecture-notes/Intro.hs: -------------------------------------------------------------------------------- 1 | module Intro where 2 | 3 | {- WELCOME TO 4 | 5 | CS316 6 | 7 | FUNCTIONAL PROGRAMMING 8 | -} 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | {- In this course, you will: 35 | 36 | - Learn more about Functional Programming (in Haskell) 37 | 38 | 39 | 40 | (Typed) Functional Programming is 41 | 42 | - Defining Datatypes To Represent Problems 43 | 44 | - Defining Functions To Create New Data From Old 45 | 46 | a.k.a "Value-oriented" programming. 47 | 48 | A "Functional Programming Language" is a programming language that 49 | is designed to make it easy to use Functional Programming ideas. -} 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | {- We use Haskell as an example Functional Programming Language. 64 | 65 | - Many languages now include ideas originally from Functional Programming. 66 | 67 | - Functions as values (a.k.a "lambdas") 68 | 69 | - Immutability 70 | 71 | - Expressive Types 72 | 73 | - Errors as data, instead of Exceptions 74 | 75 | - No 'null' (the "Billion dollar mistake") 76 | 77 | - Close tracking of possible "side effects" 78 | 79 | Haskell is not perfect (I will grumble about it during the course 80 | [*]), but it does offer a place to learn about Functional 81 | Programming concepts without too many distractions. 82 | 83 | [*] "There are only two kinds of languages: the ones people 84 | complain about and the ones nobody uses.” ― Bjarne Stroustrup, 85 | The C++ Programming Language 86 | -} 87 | 88 | 89 | 90 | 91 | 92 | 93 | 94 | 95 | 96 | 97 | {- Course arrangements: 98 | 99 | - All online 100 | Tuesdays at 11:00 : Start the week lecture 101 | Fridays at 14:00 : Tutorial with Georgi Nakov 102 | Mondays at 14:00-15:30 : Open Lab sessions 103 | 104 | - Video lectures will "live" coding 105 | - ~ 6 videos / week 106 | - ~ 10 minutes long 107 | 108 | - Online lecture notes in a GitHub repository 109 | - git clone https://github.com/bobatkey/CS316-2021.git 110 | - git pull 111 | 112 | - Tutorial sessions to go through tutorial questions 113 | 114 | -} 115 | 116 | 117 | {- This is a programming course 118 | 119 | You will be expected to do a lot of programming in order to understand the concepts. 120 | 121 | 20 credit course : 12 hrs/week, 1 hour of videos, 1 of lectures. 122 | -} 123 | 124 | 125 | 126 | 127 | 128 | 129 | 130 | 131 | 132 | 133 | 134 | 135 | 136 | 137 | 138 | {- YOU WILL NEED A WORKING HASKELL INSTALLATION 139 | 140 | - Suggested setup: 141 | 142 | - Stack + VSCode + Haskell extension 143 | 144 | - I will use Emacs in the videos. 145 | 146 | - There are instructions on MyPlace 147 | 148 | - I (unfortunately) cannot test on Windows, so I will need the 149 | class's help to iron out Windows problems. 150 | 151 | -} 152 | 153 | 154 | 155 | 156 | 157 | 158 | 159 | 160 | 161 | {- Assessment: 162 | 163 | - One class test (24 hrs) (50%) 164 | 09:00 Monday 25th October to 09:00 Tuesday 26th October 165 | 166 | - One large coursework "mini-project" (50%) 167 | Specification released Week 3 (4th October) 168 | Submission Monday 29th November 169 | 170 | -} 171 | 172 | 173 | 174 | 175 | 176 | 177 | 178 | data Suit 179 | = Heart 180 | | Club 181 | | Spade 182 | | Diamond 183 | | Circles -- IFPCASG decides this is 'Red' 184 | deriving Show 185 | 186 | data Colour 187 | = Red | Black 188 | deriving Show 189 | 190 | data Value 191 | = Ace | N2 | N3 | N4 | N5 | N6 | N7 | N8 | N9 | N10 | Jack | Queen | King 192 | deriving Show 193 | 194 | colourOfSuit :: Suit -> Colour -- public static Colour colourOfSuit(Suit s) 195 | colourOfSuit Heart = Red 196 | colourOfSuit Diamond = Red 197 | -- colourOfSuit _ = Black 198 | colourOfSuit Club = Black 199 | colourOfSuit Spade = Black 200 | colourOfSuit Circles = Red 201 | 202 | numericValue :: Value -> Integer 203 | numericValue Ace = 1 204 | numericValue N2 = 2 205 | numericValue N3 = 3 206 | numericValue N4 = 4 207 | numericValue N5 = 5 208 | numericValue N6 = 6 209 | numericValue N7 = 7 210 | numericValue N8 = 8 211 | numericValue N9 = 9 212 | numericValue N10 = 10 213 | numericValue Jack = 11 214 | numericValue Queen = 12 215 | numericValue King = 13 216 | 217 | -- Computing the ordering between card values by: 218 | -- 1. Translating from card values to Integers 219 | -- 2. Comparing the integers 220 | greaterValue :: Value -> Value -> Bool 221 | greaterValue v1 v2 = numericValue v1 > numericValue v2 222 | 223 | greaterOrEqualValue :: Value -> Value -> Bool 224 | -- greaterOrEqualValue v1 v1 = True -- not allowed 225 | greaterOrEqualValue v1 v2 = numericValue v1 >= numericValue v2 226 | 227 | data Card = MkCard Suit Value 228 | deriving Show 229 | 230 | getSuit :: Card -> Suit 231 | getSuit (MkCard suit value) = suit 232 | 233 | -- getSuit (MkCard Heart N7) 234 | 235 | 236 | -- For you to do: 237 | 238 | -- getValue :: Card -> Value 239 | 240 | -- numericOfSuit :: Suit -> Integer 241 | 242 | -- greaterSuit :: Suit -> Suit -> Bool 243 | 244 | -- greaterCard :: Card -> Card -> Bool -------------------------------------------------------------------------------- /lecture-notes/Week01Problems.hs: -------------------------------------------------------------------------------- 1 | module Week01Problems where 2 | 3 | import Week01 4 | import Prelude hiding (Left, Right, reverse) 5 | 6 | {----------------------------------------------------------------------} 7 | {- Exercises -} 8 | {----------------------------------------------------------------------} 9 | 10 | {- In the questions below, replace 'undefined' with your answers. Use 11 | GHCi to test them. -} 12 | 13 | {- 1. Write a function: -} 14 | 15 | isHorizontal :: Direction -> Bool 16 | isHorizontal = undefined 17 | 18 | {- that returns 'True' if the direction is 'Left' or 'Right', and 19 | 'False' otherwise. -} 20 | 21 | 22 | {- 2. Write a function: -} 23 | 24 | flipHorizontally :: Direction -> Direction 25 | flipHorizontally = undefined 26 | 27 | {- that flips horizontally (Left <-> Right, Up and Down stay the same). -} 28 | 29 | 30 | {- 3. Rewrite 'equalDirections' to take a 'Pair Direction Direction' as 31 | input: -} 32 | 33 | pairOfEqualDirections :: Pair Direction Direction -> Bool 34 | pairOfEqualDirections = undefined 35 | 36 | 37 | {- 4. Define a datatype 'Triple a b c' for values that have three 38 | components. Write functions 'get1of3 :: Triple a b c -> a', 39 | 'get2of3' and 'get3of3' that return the first, second and third 40 | components. You will have to come up with the type signatures 41 | for the second and third one. -} 42 | 43 | 44 | {- 5. Pattern matching on specific characters is done by writing the 45 | character to match. For example: -} 46 | 47 | isA :: Char -> Bool 48 | isA 'A' = True 49 | isA _ = False 50 | 51 | {- Write a function 'dropSpaces' :: [Char] -> [Char]' that drops 52 | spaces from the start of a list of characters. For example, we 53 | should have: 54 | 55 | *Week01Problems> dropSpaces " hello" 56 | "hello" 57 | 58 | (Strings in Haskell are really lists of 'Char's, so you can use 59 | pattern matching on them.) -} 60 | 61 | dropSpaces :: [Char] -> [Char] 62 | dropSpaces = undefined 63 | 64 | {- 6. Using 'reverse' and 'dropSpaces', write a function that removes 65 | spaces at the *end* of a list of characters. For example: 66 | 67 | *Week01Problems> dropTrailingSpaces "hello " 68 | "hello" 69 | -} 70 | 71 | dropTrailingSpaces :: [Char] -> [Char] 72 | dropTrailingSpaces = undefined 73 | 74 | {- 7. HTML escaping. When writing HTML, the characters '<', '&', and '>' 75 | are special because they are used to represent tags and 76 | entities. To have these characters display properly as 77 | themselves in HTML they need to be replaced by their entity 78 | versions: 79 | 80 | '<' becomes '<' ("less than") 81 | '>' becomes '>' ("greater than") 82 | '&' becomes '&' ("ampersand") 83 | 84 | Write a function that performs this replacement on a string. You 85 | should have, for example, 86 | 87 | Week01Problems*> htmlEscape "" 88 | "<not a tag>" 89 | -} 90 | 91 | htmlEscape :: String -> String 92 | htmlEscape = undefined 93 | 94 | {- 8. The following datatype represents a piece of text marked up with 95 | style information. -} 96 | 97 | data Markup 98 | = Text String -- ^ Some text 99 | | Bold Markup -- ^ Some markup to be styled in bold 100 | | Italic Markup -- ^ Some markup to be styled in italics 101 | | Concat Markup Markup -- ^ Two pieces of markup to be displayed in sequence 102 | 103 | {- Here is an example: -} 104 | 105 | exampleMarkup :: Markup 106 | exampleMarkup = Concat (Bold (Text "Delays")) (Concat (Text " are ") (Italic (Text "possible"))) 107 | 108 | {- Writing markup like this is tedious, especially when there are 109 | lots of 'Concat's. Write a function that takes a list of 110 | 'Markup's and concatenates them all together using 'Concat'. -} 111 | 112 | catMarkup :: [Markup] -> Markup 113 | catMarkup = undefined 114 | 115 | {- Another way of making the writing of Markup easier is the 116 | automatic insertion of spaces. Write another function that 117 | concatenates a list of 'Markup's putting spaces between them: -} 118 | 119 | catMarkupSpaced :: [Markup] -> Markup 120 | catMarkupSpaced = undefined 121 | 122 | {- Sometimes we want to remove all formatting from a piece of 123 | text. Write a function that removes all 'Bold' and 'Italic' 124 | instructions from a piece of Markup, replacing them with their 125 | underlying plain markup. 126 | 127 | For example: 128 | 129 | Week01Problems*> removeStyle exampleMarkup 130 | Concat (Text "Delays") (Concat (Text " are ") (Text "possible")) 131 | -} 132 | 133 | removeStyle :: Markup -> Markup 134 | removeStyle = undefined 135 | 136 | {- Finally, we can 'render' our markup to HTML. Write a function that 137 | converts 'Markup' to its HTML string representation, using 138 | '..' for bold and '...' for 139 | italics. Use the 'htmEscape' function from above to make sure 140 | that 'Text' nodes are correctly converted to HTML. 141 | 142 | For example: 143 | 144 | Week01Problems*> markupToHTML exampleMarkup 145 | "Delays are possible" 146 | 147 | and 148 | 149 | Week01Problems*> markupToHTML (Bold (Text "<&>")) 150 | "<&>" 151 | -} 152 | 153 | markupToHTML :: Markup -> String 154 | markupToHTML = undefined 155 | -------------------------------------------------------------------------------- /lecture-notes/Week01Intro.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -fwarn-incomplete-patterns #-} 2 | module Week01Intro where 3 | 4 | {- WELCOME TO 5 | 6 | CS316 7 | 8 | FUNCTIONAL PROGRAMMING 9 | -} 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | {- In this course, you will: 36 | 37 | - Learn more about Functional Programming (in Haskell) 38 | 39 | 40 | 41 | (Typed) Functional Programming is 42 | 43 | - Defining Datatypes To Represent Problems 44 | 45 | - Defining Functions To Create New Data From Old 46 | 47 | a.k.a "Value-oriented" programming. 48 | 49 | A "Functional Programming Language" is a programming language that 50 | is designed to make it easy to use Functional Programming ideas. -} 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | 64 | {- We use Haskell as an example Functional Programming Language. 65 | 66 | - Many languages now include ideas originally from Functional Programming. 67 | 68 | - Functions as values (a.k.a "lambdas") 69 | 70 | - "Algebraic" data types 71 | 72 | - Immutability 73 | 74 | - Expressive Types 75 | 76 | - Errors as data, instead of Exceptions 77 | 78 | - No 'null' (the "Billion dollar mistake") 79 | 80 | - Close tracking of possible "side effects" 81 | 82 | Haskell is not perfect (I will grumble about it during the course 83 | [*]), but it does offer a place to learn about Functional 84 | Programming concepts without too many distractions. 85 | 86 | [*] "There are only two kinds of languages: the ones people 87 | complain about and the ones nobody uses.” ― Bjarne Stroustrup, 88 | The C++ Programming Language 89 | -} 90 | 91 | 92 | 93 | 94 | 95 | 96 | 97 | {- Course arrangements: 98 | 99 | - In-person 100 | Tuesdays at 11:00 : Lecture in MC301 101 | Fridays at 11:00 : Lecture in JA314 102 | 103 | Mondays at 14:00-16:00 : Labs in Level 12 of Livingstone Tower 104 | Tuesdays at 14:00-16:00 : Labs in Level 13 of Livingstone Tower 105 | 106 | - Holes: 107 | - No labs on Monday 26th (Glasgow Holiday) 108 | - No lecture on Tuesday 27th 109 | 110 | - Video lectures, to support the in-person lectures 111 | - ~ 6 videos / week 112 | - ~ 10 minutes long 113 | 114 | - Online lecture notes in a GitHub repository 115 | - git clone https://github.com/bobatkey/CS316-2022.git 116 | - git pull 117 | 118 | -} 119 | 120 | 121 | {- This is a programming course 122 | 123 | You will be expected to do a lot of programming in order to understand 124 | the concepts. 125 | 126 | 20 credit course : 12 hrs/week, 1 hour of videos, 2 of lectures, 2 labs. 127 | -} 128 | 129 | 130 | 131 | 132 | 133 | 134 | 135 | 136 | 137 | 138 | 139 | 140 | 141 | 142 | 143 | {- YOU WILL NEED A WORKING HASKELL INSTALLATION 144 | 145 | - Suggested setup: 146 | 147 | - Stack + VSCode + Haskell extension. 148 | 149 | - I use Emacs in the videos and lectures. 150 | 151 | - There are instructions on MyPlace 152 | 153 | - I (unfortunately) cannot test on Windows, so I will need the 154 | class's help to iron out Windows problems. 155 | 156 | -} 157 | 158 | 159 | 160 | 161 | 162 | 163 | 164 | 165 | 166 | {- Assessment: 167 | 168 | - One class test (24 hrs) (50%) 169 | Week 6 170 | 171 | - Redemption test 172 | Week 9 173 | A second chance to do the test 174 | 175 | - One large coursework "mini-project" (50%) 176 | Specification released Week 3 (Monday 3rd October) 177 | Submission Week 11 (Monday 28th November) 178 | 179 | -} 180 | 181 | 182 | 183 | 184 | {- Some actual content: -} 185 | 186 | data Suit 187 | = Heart 188 | | Club 189 | | Spade 190 | | Diamond 191 | | Trowel 192 | deriving (Show, Eq) 193 | 194 | data Colour = Red | Black 195 | deriving Show 196 | 197 | colourOfSuit :: Suit -> Colour 198 | colourOfSuit Heart = Red 199 | colourOfSuit Club = Black 200 | colourOfSuit Spade = Black 201 | colourOfSuit Diamond = Red 202 | colourOfSuit Trowel = Black 203 | 204 | 205 | data Value 206 | = Ace | N2 | N3 | N4 | N5 | N6 | N7 | N8 | N9 | N10 | Jack | Queen | King 207 | deriving Show 208 | 209 | 210 | numericValue :: Value -> Integer 211 | numericValue Ace = 1 212 | numericValue N2 = 2 213 | numericValue N3 = 3 214 | numericValue N4 = 4 215 | numericValue N5 = 5 216 | numericValue N6 = 6 217 | numericValue N7 = 7 218 | numericValue N8 = 8 219 | numericValue N9 = 9 220 | numericValue N10 = 10 221 | numericValue Jack = 11 222 | numericValue Queen = 12 223 | numericValue King = 13 224 | 225 | 226 | greaterValue :: Value -> Value -> Bool 227 | greaterValue v1 v2 = numericValue v1 > numericValue v2 228 | 229 | 230 | 231 | data Card = MkCard Suit Value 232 | -- Card Suit Value 233 | deriving Show 234 | 235 | getSuit :: Card -> Suit 236 | getSuit (MkCard suit value) = suit 237 | 238 | getValue :: Card -> Value 239 | getValue (MkCard suit value) = value 240 | 241 | numericOfSuit :: Suit -> Integer 242 | numericOfSuit Heart = 1 243 | numericOfSuit Spade = 2 244 | numericOfSuit Club = 3 245 | numericOfSuit Diamond = 4 246 | numericOfSuit Trowel = 5 247 | 248 | greaterSuit :: Suit -> Suit -> Bool 249 | greaterSuit s1 s2 = numericOfSuit s1 > numericOfSuit s2 250 | 251 | -- instance Ord Suit where 252 | -- (>) = greaterSuit 253 | 254 | greaterCard :: Card -> Card -> Bool 255 | -- greaterCard (MkCard suit1 value1) (MkCard suit1 value2) = 256 | greaterCard (MkCard suit1 value1) (MkCard suit2 value2) = 257 | if suit1 == suit2 then greaterValue value1 value2 258 | else greaterSuit suit1 suit2 259 | -------------------------------------------------------------------------------- /lecture-notes/Week04Problems.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -fwarn-incomplete-patterns #-} 2 | module Week04Problems where 3 | 4 | import Prelude hiding (foldr, foldl, Maybe (..), Left, Right, filter, zip, map, concat) 5 | import Data.List.Split (splitOn) 6 | import Data.List hiding (foldr, foldl, filter, map, concat) 7 | import Week04 8 | 9 | {------------------------------------------------------------------------------} 10 | {- TUTORIAL QUESTIONS -} 11 | {------------------------------------------------------------------------------} 12 | 13 | {- 1. The following recursive function returns the list it is given as 14 | input: -} 15 | 16 | listIdentity :: [a] -> [a] 17 | listIdentity [] = [] 18 | listIdentity (x:xs) = x : listIdentity xs 19 | 20 | {- Write this function as a 'foldr' (fill in the 'undefined's): -} 21 | 22 | listIdentity' :: [a] -> [a] 23 | listIdentity' = foldr undefined undefined 24 | 25 | {- 2. The following recursive function does a map and a filter at the 26 | same time. If the function argument sends an element to 27 | 'Nothing' it is discarded, and if it sends it to 'Just b' then 28 | 'b' is placed in the output list. -} 29 | 30 | mapFilter :: (a -> Maybe b) -> [a] -> [b] 31 | mapFilter f [] = [] 32 | mapFilter f (x:xs) = case f x of 33 | Nothing -> mapFilter f xs 34 | Just b -> b : mapFilter f xs 35 | 36 | {- Write this function as a 'foldr' by replacing the 'undefined's: -} 37 | 38 | mapFilter' :: (a -> Maybe b) -> [a] -> [b] 39 | mapFilter' f xs = foldr undefined undefined xs 40 | 41 | 42 | 43 | {- For example, if we define -} 44 | 45 | decodeBinaryDigit :: Char -> Maybe Int 46 | decodeBinaryDigit '0' = Just 0 47 | decodeBinaryDigit '1' = Just 1 48 | decodeBinaryDigit _ = Nothing 49 | 50 | {- 51 | mapFilter' decodeBinaryDigit "a0b1c0" == [0,1,0] 52 | -} 53 | 54 | 55 | {- 3. Above we saw that 'foldl' and 'foldr' in general give different 56 | answers. However, it is possible to define 'foldl' just by using 57 | 'foldr'. 58 | 59 | First try to define a function that is the same as 'foldl', 60 | using 'foldr', 'reverse' and a '\' function: -} 61 | 62 | foldlFromFoldrAndReverse :: (b -> a -> b) -> b -> [a] -> b 63 | foldlFromFoldrAndReverse f x xs = undefined 64 | 65 | {- Much harder: define 'foldl' just using 'foldr' and a '\' function: -} 66 | 67 | foldlFromFoldr :: (b -> a -> b) -> b -> [a] -> b 68 | foldlFromFoldr f x xs = undefined 69 | 70 | 71 | {- 4. The following is a datatype of Natural Numbers (whole numbers 72 | greater than or equal to zero), represented in unary. A natural 73 | number 'n' is represented as 'n' applications of 'Succ' to 74 | 'Zero'. So '2' is 'Succ (Succ Zero)'. Using the same recipe we 75 | used above for 'Tree's and 'Maybe's, work out the type and 76 | implementation of a 'fold' function for 'Nat's. -} 77 | 78 | data Nat 79 | = Zero 80 | | Succ Nat 81 | deriving Show 82 | 83 | {- HINT: think about proofs by induction. A proof by induction has a 84 | base case and a step case. -} 85 | 86 | 87 | {- 5. Write a list comprehension to generate all the cubes (x*x*x) of 88 | the numbers 1 to 10: -} 89 | 90 | cubes :: [Int] 91 | cubes = undefined 92 | 93 | 94 | {- 6. The replicate function copies a single value a fixed number of 95 | times: 96 | 97 | > replicate 5 'x' 98 | "xxxxx" 99 | 100 | Write a version of replicate using a list comprehension: -} 101 | 102 | replicate' :: Int -> a -> [a] 103 | replicate' = undefined 104 | 105 | {- 7. One-pass Average. 106 | 107 | It is possible to use 'foldr' to 108 | implement many other interesting functions on lists. For example 109 | 'sum' and 'len': -} 110 | 111 | sumDoubles :: [Double] -> Double 112 | sumDoubles = foldr (\x sum -> x + sum) 0 113 | 114 | lenList :: [a] -> Integer 115 | lenList = foldr (\_ l -> l + 1) 0 116 | 117 | {- Putting these together, we can implement 'avg' to compute the average 118 | (mean) of a list of numbers: -} 119 | 120 | avg :: [Double] -> Double 121 | avg xs = sumDoubles xs / fromInteger (lenList xs) 122 | 123 | {- Neat as this function is, it is not as efficient as it could be. It 124 | traverses the input list twice: once to compute the sum, and then 125 | again to compute the length. It would be better if we had a single 126 | pass that computed the sum and length simultaneously and returned a 127 | pair. 128 | 129 | Implement such a function, using foldr: -} 130 | 131 | sumAndLen :: [Double] -> (Double, Integer) 132 | sumAndLen = undefined 133 | 134 | {- Once you have implemented your 'sumAndLen' function, this alternative 135 | average function will work: -} 136 | 137 | avg' :: [Double] -> Double 138 | avg' xs = total / fromInteger length 139 | where (total, length) = sumAndLen xs 140 | 141 | {- 8. mapTree from foldTree 142 | 143 | Here is the 'Tree' datatype that is imported from the Week04 module: 144 | 145 | data Tree a 146 | = Leaf 147 | | Node (Tree a) a (Tree a) 148 | deriving Show 149 | 150 | As we saw in the lecture notes, it is possible to write a generic 151 | recursor pattern for trees, similar to 'foldr', copied here for reference: 152 | 153 | foldTree :: b -> (b -> a -> b -> b) -> Tree a -> b 154 | foldTree l n Leaf = l 155 | foldTree l n (Node lt x rt) = n (foldTree l n lt) x (foldTree l n rt) 156 | 157 | Your job is to implement 'mapTree' (from Week03) in terms of 158 | 'foldTree': -} 159 | 160 | mapTree :: (a -> b) -> Tree a -> Tree b 161 | mapTree = undefined 162 | 163 | {- Here is the explicitly recursive version of 'mapTree', for 164 | reference: -} 165 | 166 | mapTree0 :: (a -> b) -> Tree a -> Tree b 167 | mapTree0 f Leaf = Leaf 168 | mapTree0 f (Node lt x rt) = Node (mapTree0 f lt) (f x) (mapTree0 f rt) 169 | 170 | {- 9. Finally, use 'foldTree' to flatten a tree to list in left-to-right 171 | order: -} 172 | 173 | flatten :: Tree a -> [a] 174 | flatten = undefined 175 | -------------------------------------------------------------------------------- /lecture-notes/Week06Problems.hs: -------------------------------------------------------------------------------- 1 | module Week06Problems where 2 | 3 | {------------------------------------------------------------------------------} 4 | {- TUTORIAL QUESTIONS -} 5 | {------------------------------------------------------------------------------} 6 | 7 | data Tree a 8 | = Leaf 9 | | Node (Tree a) a (Tree a) 10 | deriving Show 11 | 12 | {- 1. Using 'Result' to handle errors. 13 | 14 | Here is the 'Result' type described in the notes. It is like the 15 | 'Maybe' type except that the "fail" case has a String message 16 | attached: -} 17 | 18 | data Result a 19 | = Ok a 20 | | Error String 21 | deriving (Eq, Show) 22 | 23 | {- Implement 'returnOK', 'failure', 'ifOK' and 'catch' for 'Result' 24 | instead of 'Maybe'. Note that in 'failure' we have to provide an 25 | error message, and in 'catch' the "exception handler" gets the 26 | error message. -} 27 | 28 | returnOk :: a -> Result a 29 | returnOk = undefined 30 | 31 | failure :: String -> Result a 32 | failure = undefined 33 | 34 | ifOK :: Result a -> (a -> Result b) -> Result b 35 | ifOK = undefined 36 | 37 | catch :: Result a -> (String -> Result a) -> Result a 38 | catch = undefined 39 | 40 | {- Reimplement 'search' to use 'Result' instead of 'Maybe'. We add 'Show 41 | k' to the requirements, so that we can put the key that wasn't 42 | found in the error message. -} 43 | 44 | search :: (Show k, Eq k) => k -> [(k,v)] -> Result v 45 | search = undefined 46 | 47 | {- Finally, reimplement 'lookupAll v4' to return 'Result (Tree v)' 48 | instead of 'Maybe (Tree v)'. (The code will be identical!) -} 49 | 50 | lookupAll_v4 :: (Show k, Eq k) => [(k,v)] -> Tree k -> Result (Tree v) 51 | lookupAll_v4 = undefined 52 | 53 | 54 | 55 | {- 2. Processes 56 | 57 | The following data type represents processes that can 'Input' lines 58 | and carry on given information about what that line is; 'Output' 59 | lines and then carry on being a process; or 'End', with a value. -} 60 | 61 | data Process a 62 | = End a 63 | | Input (String -> Process a) 64 | | Output String (Process a) 65 | 66 | {- Here is an example process, written out in full. It implements a 67 | simple interactive program: -} 68 | 69 | interaction :: Process () 70 | interaction = 71 | Output "What is your name?" 72 | (Input (\name -> 73 | Output ("Hello " ++ name ++ "!") (End ()))) 74 | 75 | {- Processes by themselves do not do anything. They are only 76 | descriptions of what to do. To have an effect on the world, we to 77 | need to translate them to Haskell's primitives for doing I/O (we 78 | will cover this in more detail in Week 08): -} 79 | 80 | runProcess :: Process a -> IO a 81 | runProcess (End a) = return a 82 | runProcess (Input k) = do line <- getLine; runProcess (k line) 83 | runProcess (Output line p) = do putStrLn line; runProcess p 84 | 85 | {- Now we can run the 'interaction' described above: 86 | 87 | > runProcess interaction 88 | What is your name? 89 | Bob <--- this line entered by the user 90 | Hello Bob! 91 | -} 92 | 93 | {- Writing out processes in the style of 'interaction' above is annoying 94 | due to the brackets needed. We can make it simpler by defining some 95 | functions, First we define two basic operations: 'input' and 96 | 'output', which are little "mini-Processes" that do one input or 97 | output operation. -} 98 | 99 | input :: Process String 100 | input = Input (\x -> End x) 101 | 102 | output :: String -> Process () 103 | output s = Output s (End ()) 104 | 105 | {- The key operation is sequencing of processes. First we (simulate) run 106 | one process, then we take the result value from that and use it to 107 | make a second process which we run. Note that this has the same 108 | flavour as the 'ifOK', 'andThen' and 'andThenWithPrinting' 109 | functions from the notes. -} 110 | 111 | sequ :: Process a -> (a -> Process b) -> Process b 112 | sequ (End a) f = undefined 113 | sequ (Input k) f = undefined 114 | sequ (Output s p) f = undefined 115 | 116 | {- HINT: this is very very similar to the 'subst' function from the Week 117 | 03 problems. 118 | 119 | Once you have 'sequ', you can define a neater version of 120 | 'interaction' that makes the sequential nature clearer: -} 121 | 122 | interaction_v2 :: Process () 123 | interaction_v2 = 124 | output "What is your name?" `sequ` \() -> 125 | input `sequ` \name -> 126 | output ("Hello " ++ name ++ "!") `sequ` \() -> 127 | End () 128 | 129 | {- Running 'runProcess interaction_v2' should have the same effect as 130 | running 'runProcess interaction' did. 131 | 132 | Let's put sequ to work. 133 | 134 | Implement an interactive 'map' using 'input', 'output' and 135 | 'sequ'. This is a 'map' that prompts the user for what string to 136 | use to replace each string in the input list. This will be similar 137 | to printAndSum_v2 from the notes. 138 | 139 | For example: 140 | 141 | > runProcess (interactiveMap ["A","B","C"]) 142 | A 143 | a 144 | B 145 | b 146 | C 147 | c 148 | ["a","b","c"] 149 | 150 | where the lower case lines are entered by the user. -} 151 | 152 | interactiveMap :: [String] -> Process [String] 153 | interactiveMap = undefined 154 | 155 | {- Finally, implement a function that does an 'interactive filter', 156 | similar to the interactive map. For every element in the input 157 | list, it outputs it and prompts for user input. If the user types 158 | "y" then the element is kept. If the user types anything else, it 159 | is not copied into the output list. -} 160 | 161 | interactiveFilter :: Show a => [a] -> Process [a] 162 | interactiveFilter = undefined 163 | 164 | {- For example, 165 | 166 | > runProcess (interactiveFilter ["A","B","C"]) 167 | Keep "A"? 168 | y 169 | Keep "B"? 170 | n 171 | Keep "C"? 172 | y 173 | ["A","C"] 174 | 175 | -} 176 | -------------------------------------------------------------------------------- /lecture-notes/Week07Solutions.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE InstanceSigs #-} 2 | {-# LANGUAGE RebindableSyntax #-} 3 | {-# OPTIONS_GHC -fwarn-incomplete-patterns #-} 4 | module Week07Solutions where 5 | 6 | import Prelude hiding ( Monad (..) 7 | , Applicative (..) 8 | , mapM 9 | , mapM_ 10 | , (<$>)) 11 | import Week07 hiding (search, lookupAll, ifThenElse, (>>)) 12 | 13 | {- This is needed due to the RebindableSyntax extension. I'm using this 14 | extension so the 'do' notation in this file uses my redefined 15 | 'Monad' type class, not the standard library one. RebindableSyntax 16 | lets the user redefine what 'do', and 'if' mean. I've given 'if' 17 | the standard meaning here: -} 18 | ifThenElse True x y = x 19 | ifThenElse False x y = y 20 | (>>) x y = x >>= \_ -> y 21 | 22 | {------------------------------------------------------------------------------} 23 | {- TUTORIAL QUESTIONS -} 24 | {------------------------------------------------------------------------------} 25 | 26 | {- 1. The 'Maybe' monad is useful for simulating exceptions. But when an 27 | exception is thrown, we don't get any information on what the 28 | exceptional condition was! The way to fix this is to use a type 29 | that includes some information on the 'Error' case: -} 30 | 31 | data Result a 32 | = Ok a 33 | | Error String 34 | deriving Show 35 | 36 | {- Write a Monad instance for 'Result', using the code from your 37 | 'returnOk' and 'ifOK' functions from last week, and then use it 38 | to rewrite the 'search' and 'lookupAll' functions. -} 39 | 40 | instance Monad Result where 41 | return = Ok 42 | 43 | Ok x >>= k = k x 44 | Error msg >>= k = Error msg 45 | 46 | search :: (Show k, Eq k) => k -> [(k,v)] -> Result v 47 | search k [] = Error ("Key '" ++ show k ++ "' not found") 48 | search k ((k',v'):kvs) = 49 | if k == k' then 50 | return v' 51 | else 52 | search k kvs 53 | 54 | lookupAll :: (Show k, Eq k) => [(k,v)] -> Tree k -> Result (Tree v) 55 | lookupAll kvs Leaf = 56 | return Leaf 57 | lookupAll kvs (Node l k r) = 58 | do l' <- lookupAll kvs l 59 | v <- search k kvs 60 | r' <- lookupAll kvs r 61 | return (Node l' v r') 62 | 63 | 64 | {- 2. Write a function using the Printing monad and 'do' notation that 65 | "prints out" all the strings in a tree of 'String's: -} 66 | 67 | printTree :: Tree String -> Printing () 68 | printTree Leaf = 69 | return () 70 | printTree (Node l x r) = 71 | do printTree l 72 | printLine x 73 | printTree r 74 | 75 | 76 | {- 3. The implementation of 'sumImp' in the notes can only sum up lists 77 | of 'Int's. 78 | 79 | (a) What changes would you have to make to 'State' so that you 80 | can add up lists of 'Double's? You'll have to make a new 81 | newtype like 'State', and reimplement the 'runState', the 82 | 'Monad' instance, the 'get' and 'put' function, and finally 83 | the 'sumpImp' function. The changes to the actual code will 84 | be minimal, if anything. All the changes are in the types. -} 85 | 86 | -- To do this, we modify the 'State' newtype, to change the 'Int's to 87 | -- 'Double's. I have added the suffix 'D' for 'D'ouble. 88 | 89 | newtype StateD a = MkStateD (Double -> (Double, a)) 90 | 91 | -- Then we write the functions again, with new types: 92 | 93 | runStateD :: StateD a -> Double -> (Double, a) 94 | runStateD (MkStateD t) = t 95 | 96 | instance Monad StateD where 97 | return :: a -> StateD a 98 | return x = 99 | MkStateD (\s -> (s, x)) 100 | 101 | (>>=) :: StateD a -> (a -> StateD b) -> StateD b 102 | op >>= f = 103 | MkStateD (\s -> 104 | let (s0, a) = runStateD op s 105 | (s1, b) = runStateD (f a) s0 106 | in (s1, b)) 107 | 108 | getD :: StateD Double 109 | getD = MkStateD (\s -> (s,s)) 110 | 111 | putD :: Double -> StateD () 112 | putD i = MkStateD (\_ -> (i,())) 113 | 114 | sumImpD :: [Double] -> StateD Double 115 | sumImpD xs = 116 | do putD 0 117 | for_ xs (\x -> do 118 | total <- getD 119 | putD (total + x)) 120 | result <- getD 121 | return result 122 | 123 | {- (b) Make an alternative version of 'State' that is parameterised 124 | by the type of the state (so that someone using it can 125 | decide whether it is 'Int' or 'Double' for instance). -} 126 | 127 | -- To do this, we add an extra parameter to the 'State' newtype, which 128 | -- we call 's' here. I have added the suffix 'G' for 'G'eneric. 129 | 130 | newtype StateG s a = MkStateG (s -> (s, a)) 131 | 132 | -- then we rewrite all our functions with basically the same code, but 133 | -- more general types: 134 | 135 | runStateG :: StateG s a -> s -> (s, a) 136 | runStateG (MkStateG t) = t 137 | 138 | instance Monad (StateG s) where 139 | return :: a -> StateG s a 140 | return x = 141 | MkStateG (\s -> (s, x)) 142 | 143 | (>>=) :: StateG s a -> (a -> StateG s b) -> StateG s b 144 | op >>= f = 145 | MkStateG (\s -> 146 | let (s0, a) = runStateG op s 147 | (s1, b) = runStateG (f a) s0 148 | in (s1, b)) 149 | 150 | getG :: StateG s s 151 | getG = MkStateG (\s -> (s,s)) 152 | 153 | putG :: s -> StateG s () 154 | putG i = MkStateG (\_ -> (i,())) 155 | 156 | sumImpG :: Monoid m => [m] -> StateG m m 157 | sumImpG xs = 158 | do putG mempty 159 | for_ xs (\x -> do 160 | total <- getG 161 | putG (total <> x)) 162 | result <- getG 163 | return result 164 | 165 | {- 4. Write a function like mapM that works on 'Tree's instead of lists: -} 166 | 167 | mapTreeM :: Monad m => (a -> m b) -> Tree a -> m (Tree b) 168 | mapTreeM f Leaf = return Leaf 169 | mapTreeM f (Node l x r) = 170 | do l' <- mapTreeM f l 171 | y <- f x 172 | r' <- mapTreeM f r 173 | return (Node l' y r') 174 | 175 | 176 | {- 5. Write a function like mapM that works on 'Maybe's instead of lists: -} 177 | 178 | mapMaybeM :: Monad m => (a -> m b) -> Maybe a -> m (Maybe b) 179 | mapMaybeM f Nothing = return Nothing 180 | mapMaybeM f (Just x) = 181 | do y <- f x 182 | return (Just y) 183 | -------------------------------------------------------------------------------- /lecture-notes/Week05Intro.hs: -------------------------------------------------------------------------------- 1 | module Week05Intro where 2 | 3 | import Prelude hiding (Left, Right, Semigroup (..), Foldable (..), Functor (..), Monoid (..), Maybe (..)) 4 | import Data.Char (toUpper) 5 | 6 | 7 | 8 | {- WEEK 05 : CLASSES OF TYPES -} 9 | 10 | --- REMINDER : Test next Wednesday / Thursday 11 | --- REMINDER : Coursework has been released; start now to avoid stress 12 | 13 | 14 | 15 | 16 | 17 | 18 | {- Part 01 : Type Design -} 19 | 20 | 21 | -- Haskell takes types very, very seriously 22 | 23 | 24 | -- Playing Cards 25 | data Suit 26 | = Hearts 27 | | Diamonds 28 | | Clubs 29 | | Spades 30 | deriving (Show, Eq) 31 | 32 | {- 33 | static int hearts = 0; 34 | static int diamonds = 1; 35 | static int clubs = 2; 36 | static int spades = 3; 37 | 38 | #define CLUBS 2 39 | 40 | typedef enum { 41 | hearts, diamonds, clubs, spades 42 | } suit; 43 | 44 | switch (x) { 45 | case hearts: sdfsdf break; 46 | case diamonds: skdjh break; 47 | case clubs: .. break; 48 | case spades: .. break; 49 | }; 50 | 51 | -} 52 | 53 | -- Student records 54 | 55 | {- a student is (represented by) 56 | 57 | - a name 58 | - either a ds username or a registration number, or both 59 | -} 60 | 61 | {- 62 | public class Student { 63 | @Nonnull 64 | private String name; 65 | 66 | // Please let (at least) one of these be non-null 67 | private String dsUsername; 68 | private String regNumber; 69 | 70 | ... 71 | } 72 | -} 73 | 74 | -- Type synonyms vs data type declarations 75 | type DSUsername = String 76 | newtype RegNumber = MkRegNumber String 77 | deriving (Eq,Show) 78 | 79 | 80 | -- (Char Char, Char, Char, Char, Char, Char, Char, Char) 81 | 82 | -- typedef char* username; 83 | 84 | data StudentDetails 85 | = DSUsername DSUsername 86 | | RegNumber RegNumber 87 | | BothDSAndReg DSUsername RegNumber 88 | deriving (Eq, Show) 89 | 90 | {- DSUsername is not a type -} 91 | 92 | {- "Make Illegal States Unrepresentable" 93 | 94 | 95 | "The Billion-dollar mistake" -- Sir Tony Hoare on the null pointer 96 | -} 97 | 98 | {- 99 | data Maybe a 100 | = Nothing 101 | | Just a 102 | 103 | -- Java's Optional class 104 | -- Rust, Swift, others. Result type 105 | -} 106 | 107 | 108 | 109 | 110 | {- Part 02 : Type classes -} 111 | 112 | 113 | -- what does deriving (Eq, Show) mean? 114 | 115 | -- Monomorphic : total :: [Int] -> Int 116 | -- Polymorphic / Generics : length :: [a] -> Int 117 | 118 | -- Ad hoc polymorphism : (==) :: String -> String -> Bool 119 | -- (==) :: Int -> Int -> Bool 120 | -- (==) :: Double -> Double -> Bool 121 | -- (==) :: (String -> Bool) -> (String -> Bool) -> Bool -- none such 122 | 123 | -- C-style: specific functions: strcmp, etc. 124 | 125 | -- Java-style, "OO"-style: x.equals(y), x.toString() 126 | -- x.compare(y) -- analogous to the Ord typeclass 127 | 128 | -- show :: String -> String 129 | -- show :: Int -> String 130 | 131 | -- typeclass : specification for a group of functions that a type may have 132 | 133 | {- class Eq a where 134 | (==) :: a -> a -> Bool 135 | (/=) :: a -> a -> Bool 136 | x /= y = not (x == y) 137 | x == y = not (x /= y) 138 | -} 139 | 140 | newtype CaseInsenstiveString = 141 | MkCIString String 142 | -- deriving (Eq) 143 | 144 | instance Eq CaseInsenstiveString where 145 | MkCIString x == MkCIString y = 146 | map toUpper x == map toUpper y 147 | 148 | -- Type classes: 149 | -- - Allow overloading of names (e.g., (==)) 150 | -- - Allow us to define custom behaviours based on the types 151 | -- - Codify certain patterns of behaviour as interfaces 152 | 153 | 154 | 155 | 156 | 157 | 158 | {- Part 03 : Semigroups and Monoids -} 159 | 160 | -- Addable AddableWithAZero 161 | 162 | -- Typeclass design: 163 | -- - A type is an X if it supports functions A, B, C ... 164 | -- - How do we choose what things to call interfaces? 165 | -- - Can be tricky to find coherent abstractions 166 | 167 | class Semigroup a where 168 | (<>) :: a -> a -> a 169 | 170 | instance Semigroup Int where 171 | x <> y = x + y 172 | 173 | instance Semigroup Bool where 174 | x <> y = x && y 175 | 176 | instance Semigroup [a] where 177 | x <> y = x ++ y 178 | 179 | data Maybe a = Nothing | Just a deriving Show 180 | 181 | -- Take the first 182 | instance Semigroup (Maybe a) where 183 | Nothing <> x = x 184 | Just a <> _ = Just a 185 | 186 | -- Combine the successes 187 | {- 188 | instance Semigroup a => Semigroup (Maybe a) where 189 | Nothing <> x = x 190 | x <> Nothing = x 191 | Just a <> Just b = Just (a <> b) 192 | -} 193 | 194 | -- Law of a semigroup: 195 | -- a <> (b <> c) = (a <> b) <> c -- associativity 196 | 197 | -- a <> b <> c <> d 198 | -- a <> (b <> (c <> d)) -- sequential 199 | -- (a <> b) <> (c <> d) -- parallel 200 | 201 | -- a <> b = b <> a --- NOT REQUIRED commutativity 202 | 203 | class Semigroup a => Monoid a where 204 | mempty :: a 205 | 206 | -- mempty <> x = x 207 | -- x <> mempty = x 208 | 209 | instance Monoid Int where 210 | mempty = 0 211 | 212 | instance Monoid Bool where 213 | mempty = True 214 | 215 | instance Monoid [a] where 216 | mempty = [] 217 | 218 | instance Monoid (Maybe a) where 219 | mempty = Nothing 220 | 221 | 222 | {- Part 04 : Foldable -} 223 | 224 | crush :: Monoid a => [a] -> a 225 | crush [] = mempty 226 | crush (x:xs) = x <> crush xs 227 | 228 | data Tree a 229 | = Leaf 230 | | Node (Tree a) a (Tree a) 231 | deriving Show 232 | 233 | crushTree :: Monoid a => Tree a -> a 234 | crushTree Leaf = mempty 235 | crushTree (Node l x r) = crushTree l <> x <> crushTree r 236 | 237 | class Foldable c where 238 | fold :: Monoid a => c a -> a 239 | 240 | instance Foldable [] where 241 | fold = crush 242 | 243 | instance Foldable Tree where 244 | fold = crushTree 245 | 246 | {- Part 05 : Functor / Mappable -} 247 | 248 | -- addLengths :: [String] -> Int 249 | -- addLengths = fold . map length 250 | 251 | class Functor c where 252 | fmap :: (a -> b) -> c a -> c b 253 | 254 | forall :: (Foldable c, Functor c) => (a -> Bool) -> c a -> Bool 255 | forall p = fold . fmap p 256 | -- = \x -> fold (fmap p x) 257 | 258 | -- f . g = \x -> f (g x) 259 | 260 | 261 | {- combining fmap and fold covers a broad range of programming problems. 262 | 263 | with a bit more work it is amenable to parallelism 264 | 265 | lifts the level of abstraction in programming 266 | -} 267 | -------------------------------------------------------------------------------- /lecture-notes/Week02Problems.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -fwarn-incomplete-patterns #-} 2 | module Week02Problems where 3 | 4 | import Week02 5 | 6 | {------------------------------------------------------------------------------} 7 | {- TUTORIAL QUESTIONS -} 8 | {------------------------------------------------------------------------------} 9 | 10 | {- In the questions below, replace 'undefined' with your answers. Use 11 | GHCi to test them.-} 12 | 13 | {- 1. Write a function that counts the number of occurrences of an 14 | element in list: -} 15 | 16 | popCount :: Eq a => a -> [a] -> Int 17 | popCount = undefined 18 | 19 | {- (popCount is short for "population count"). Examples: 20 | 21 | popCount 2 [1,2,5,2,7,2,9] == 3 22 | popCount 9 [1,2,5,2,7,2,9] == 1 23 | popCount 0 [1,2,5,2,7,2,9] == 0 24 | -} 25 | 26 | 27 | {- 2. Write a version of 'insert' that only inserts into a sorted list 28 | if the element is not already there. Examples: 29 | 30 | insertNoDup 2 [1,3,4] == [1,2,3,4] 31 | insertNoDup 2 [1,2,3,4] == [1,2,3,4] 32 | -} 33 | 34 | insertNoDup :: Ord a => a -> [a] -> [a] 35 | insertNoDup = undefined 36 | 37 | 38 | {- 3. Write a version of 'remove' that removes all copies of an element 39 | from a sorted list, not just the first one. Examples: 40 | 41 | removeAll 2 [1,2,2,3] == [1,3] 42 | removeAll 2 [1,3] == [1,3] 43 | -} 44 | 45 | removeAll :: Ord a => a -> [a] -> [a] 46 | removeAll = undefined 47 | 48 | 49 | {- 4. Rewrite 'treeFind' and 'treeInsert' to use 'compare' and 'case' 50 | expressions. -} 51 | 52 | treeFind2 :: Ord k => k -> KV k v -> Maybe v 53 | treeFind2 = undefined 54 | 55 | treeInsert2 :: Ord k => k -> v -> KV k v -> KV k v 56 | treeInsert2 = undefined 57 | 58 | 59 | {- 5. MergeSort is another sorting algorithm that works in the following 60 | way: 61 | 62 | - If the list to be sorted is zero length, then it is already 63 | sorted. 64 | 65 | - If the list to be sorted has one element, then it is already 66 | sorted. 67 | 68 | - Otherwise, split the list into two, one with the even elements 69 | and one with the odd elements. Sort the two lists by calling 70 | 'mergeSort' recursively. Then merge the two lists together 71 | maintaining the ordering. 72 | 73 | Write this function in three parts: -} 74 | 75 | {- 'split' splits the input into two lists: one with the odd numbered 76 | elements and one with the even numbered elements. HINT: you can 77 | pattern match on multiple elements at the head of a list with 78 | 'x1:x2:xs', and you can use the '(odds,evens) = ...' syntax in a 79 | 'where' clause. -} 80 | 81 | split :: [a] -> ([a], [a]) 82 | split = undefined 83 | 84 | {- 'merge' merges two sorted lists into one sorted list. Examples: 85 | 86 | merge [1,3,5] [2,4,6] = [1,2,3,4,5,6] 87 | merge [1,3,5] [7,9,11] = [1,3,5,7,9,11] 88 | -} 89 | 90 | merge :: Ord a => [a] -> [a] -> [a] 91 | merge = undefined 92 | 93 | {- 'mergeSort' uses 'split' and 'merge' to implement the merge sort 94 | algorithm described above. -} 95 | 96 | mergeSort :: Ord a => [a] -> [a] 97 | mergeSort = undefined 98 | 99 | 100 | {- 6. Write another version of 'makeChange' that returns all the 101 | possible ways of making change as a list: -} 102 | 103 | makeChangeAll :: [Coin] -> [Coin] -> Int -> [[Coin]] 104 | makeChangeAll = undefined 105 | 106 | {- HINT: you don't need a case expression, just a way of appending two 107 | lists of possibilities. -} 108 | 109 | {- 7. This question involves converting between two datatypes. A 'Row' 110 | is a list of strings, such as you might find in a database: -} 111 | 112 | -- | A row is a list of strings, one for each field. For example: 113 | -- 114 | -- > ["Mount Snowden", "Wales"] 115 | type Row = [String] 116 | 117 | {- Note that the names of the fields, which might be 'Mountain' and 118 | 'Country' here, are implicit in this representation. 119 | 120 | The second type is a record, which is a list of pairs of field 121 | names with their data: -} 122 | 123 | -- | A record is a list of fieldname / value pairs. For example: 124 | -- 125 | -- > [("Mountain", "Mont Blanc"), ("Country", "France")] 126 | type Record = [(String,String)] 127 | 128 | {- Implement the following functions on rows and records: -} 129 | 130 | -- | Look up a field in a record, returning @Nothing@ if the field is 131 | -- not in the record. For example, 132 | -- > lookupField "a" [("a","1"),("b","2")] 133 | -- returns @Just "1"@, but 134 | -- > lookupField "c" [("a","1"),("b","3")] 135 | -- returns @Nothing@. 136 | lookupField :: String -> Record -> Maybe String 137 | lookupField fieldname record = 138 | error "lookupField: not implemented" 139 | 140 | -- | Given a header listing field names, like: 141 | -- 142 | -- > ["Mountain", "Country"] 143 | -- 144 | -- and a row like: 145 | -- 146 | -- > ["Ben Nevis", "Scotland"] 147 | -- 148 | -- turn it into a record like: 149 | -- 150 | -- > [("Mountain", "Ben Nevis"), ("Country", "Scotland")] 151 | -- 152 | -- If the number of field names in the header does not match the 153 | -- number of fields in the row, an @Nothing@ should be returned. 154 | rowToRecord :: [String] -> Row -> Maybe Record 155 | rowToRecord header row = 156 | error "rowToRecord: not implemented" 157 | 158 | -- | Given a header listing field names, and a list of rows, converts 159 | -- each row into a record. See 'rowToRecord' for how individual rows 160 | -- are converted to records. 161 | rowsToRecords :: [String] -> [Row] -> Maybe [Record] 162 | rowsToRecords header rows = 163 | error "rowsToRecord: not implemented" 164 | 165 | -- | Given a header listing field names, like: 166 | -- 167 | -- > ["Mountain", "Country"] 168 | -- 169 | -- and a record like: 170 | -- 171 | -- > [("Mountain", "Ben Nevis"), ("Country", "Scotland")] 172 | -- 173 | -- turn it into a row like: 174 | -- 175 | -- > ["Ben Nevis", "Scotland"] 176 | -- 177 | -- It does not matter what order the fields in the record are in, so the 178 | -- record: 179 | -- 180 | -- > [("Country", "Scotland"), ("Mountain", "Ben Nevis")] 181 | -- 182 | -- should result in the same row. 183 | -- 184 | -- This function returns an @Nothing@ if any of the field names listed in 185 | -- the header are not in the record. 186 | recordToRow :: [String] -> Record -> Maybe Row 187 | recordToRow header record = 188 | error "recordToRow: not implemented" 189 | 190 | -- | Given a header listing field names, and a list of records, 191 | -- converts each record into a row. See 'recordToRow' for how 192 | -- individual records are converted to rows. 193 | recordsToRows :: [String] -> [Record] -> Maybe [Row] 194 | recordsToRows header records = 195 | error "recordsToRows: not implemented" 196 | -------------------------------------------------------------------------------- /lecture-notes/Week09Intro.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE InstanceSigs #-} 2 | {-# OPTIONS_GHC -fwarn-incomplete-patterns #-} 3 | module Week09Intro where 4 | 5 | import Control.Concurrent (forkIO, MVar, newEmptyMVar, putMVar, takeMVar) 6 | import Prelude hiding (mapM) 7 | import Data.Traversable (for) 8 | import Network.HTTP ( simpleHTTP 9 | , getRequest 10 | , getResponseBody 11 | ) 12 | import Week08 (Parser, runParser, JSON (..), parseJSON) 13 | 14 | 15 | 16 | {- WEEK 9 : DATA DEPENDENCIES and APPLICATIVE FUNCTORS -} 17 | 18 | 19 | 20 | {- PART 9.1 : Sequences of Actions -} 21 | 22 | {- 23 | class Monad m where 24 | return :: a -> m a 25 | (>>=) :: m a -> (a -> m b) -> m b 26 | -} 27 | 28 | -- Sequences of actions: mapM, mapTreeM 29 | 30 | mapM :: Monad m => (a -> m b) -> [a] -> m [b] 31 | mapM f [] = return [] 32 | mapM f (x:xs) = 33 | do y <- f x 34 | ys <- mapM f xs 35 | return (y:ys) 36 | 37 | -- map f [] = [] 38 | -- map f (x:xs) = (:) (f x) (map f xs) 39 | 40 | lift2 :: Monad m => (a -> b -> c) -> m a -> m b -> m c 41 | lift2 f ma mb = 42 | do a <- ma 43 | b <- mb 44 | return (f a b) 45 | 46 | mapM_v2 :: Monad m => (a -> m b) -> [a] -> m [b] 47 | mapM_v2 f [] = return [] 48 | mapM_v2 f (x:xs) = lift2 (:) (f x) (mapM_v2 f xs) 49 | 50 | data Tree a 51 | = Leaf 52 | | Node (Tree a) a (Tree a) 53 | deriving Show 54 | 55 | mapTreeM :: Monad m => (a -> m b) -> Tree a -> m (Tree b) 56 | mapTreeM f Leaf = return Leaf 57 | mapTreeM f (Node l x r) = 58 | do l' <- mapTreeM f l 59 | y <- f x 60 | r' <- mapTreeM f r 61 | return (Node l' y r') 62 | 63 | -- mapTreeM_v2 f (Node l x r) = lift3 Node (mapTreeM_v2 f l) (f x) (mapTreeM_v2 f r) 64 | 65 | {- 66 | do isChar '"' 67 | xs <- zeroOrMore stringChar 68 | isChar '"' 69 | return xs 70 | -} 71 | 72 | 73 | -- lift1, lift2, lift3, lift4 74 | 75 | -- apply 76 | 77 | -- f :: Int -> String -> Char 78 | 79 | -- f 1 :: String -> Char 80 | 81 | -- f 1 "a" :: Char 82 | 83 | apply :: (a -> b) -> a -> b 84 | apply f a = f a 85 | 86 | -- f `apply` 1 `apply` "a" 87 | 88 | mapply :: Monad m => m (a -> b) -> m a -> m b 89 | mapply mf ma = 90 | do f <- mf 91 | a <- ma 92 | return (f a) 93 | 94 | lift2_v2 :: Monad m => (a -> b -> c) -> m a -> m b -> m c 95 | lift2_v2 f ma mb = ((return f) `mapply` ma) `mapply` mb 96 | 97 | mapM_v3 :: Monad m => (a -> m b) -> [a] -> m [b] 98 | mapM_v3 f [] = return [] 99 | mapM_v3 f (x:xs) = return (:) `mapply` (f x) `mapply` (mapM_v3 f xs) 100 | 101 | 102 | 103 | {- PART 9.2 : Applicative, a new type class -} 104 | 105 | {- 106 | class Functor f => Applicative f where 107 | pure :: a -> f a 108 | (<*>) :: f (a -> b) -> f a -> f b 109 | -} 110 | 111 | mapM_v4 :: Applicative m => (a -> m b) -> [a] -> m [b] 112 | mapM_v4 f [] = pure [] 113 | mapM_v4 f (x:xs) = pure (:) <*> (f x) <*> (mapM_v4 f xs) 114 | 115 | 116 | 117 | 118 | {- PART 9.3 : Data Dependencies and Parallelism -} 119 | 120 | -- Requests and Responses 121 | type Request = String 122 | type Response = String 123 | 124 | -- Fetch 125 | data Fetch a 126 | = Blocked [Request] ([Response] -> Fetch a) 127 | | Return a 128 | 129 | instance Show a => Show (Fetch a) where 130 | show (Blocked requests _) = "Blocked " ++ show requests ++ " " 131 | show (Return a) = "Return " ++ show a 132 | 133 | makeRequest :: Request -> Fetch Response 134 | makeRequest uri = Blocked [uri] (\[response] -> Return response) 135 | 136 | -- Monad 137 | instance Monad Fetch where 138 | return :: a -> Fetch a 139 | return x = Return x 140 | 141 | (>>=) :: Fetch a -> (a -> Fetch b) -> Fetch b 142 | Blocked reqs fetch >>= k = Blocked reqs (\resps -> (fetch resps) >>= k) 143 | Return a >>= k = k a 144 | 145 | instance Applicative Fetch where 146 | pure :: a -> Fetch a 147 | pure = return 148 | 149 | (<*>) :: Fetch (a -> b) -> Fetch a -> Fetch b 150 | Blocked reqs1 fetch1 <*> Blocked reqs2 fetch2 = 151 | Blocked (reqs1 ++ reqs2) (\resps -> let resp1 = take (length reqs1) resps 152 | resp2 = drop (length reqs1) resps 153 | in fetch1 resp1 <*> fetch2 resp2) 154 | Blocked reqs1 fetch1 <*> Return a = 155 | Blocked reqs1 (\resp -> fetch1 resp <*> Return a) 156 | Return f <*> Blocked reqs2 fetch2 = 157 | Blocked reqs2 (\resp -> Return f <*> fetch2 resp) 158 | Return f <*> Return a = 159 | Return (f a) 160 | 161 | instance Functor Fetch where 162 | fmap f ma = pure f <*> ma 163 | 164 | 165 | sequentialRequests :: Fetch (Response, Response) 166 | sequentialRequests = 167 | do resp1 <- makeRequest "a" 168 | resp2 <- makeRequest "b" 169 | return (resp1, resp2) 170 | 171 | parallelRequests :: Fetch (Response, Response) 172 | parallelRequests = 173 | pure (\resp1 resp2 -> (resp1, resp2)) 174 | <*> makeRequest "a" 175 | <*> makeRequest "b" 176 | 177 | 178 | {- So far, we've just described a small Domain Specific Language (DSL) 179 | for talking about web requests, with the feature that it can 180 | distinguish between sequential and parallel dependencies. 181 | 182 | -} 183 | 184 | 185 | {- Part 9.4 : Concurrency and Communication -} 186 | 187 | -- forkIO 188 | 189 | concurrentMessages :: IO () 190 | concurrentMessages = 191 | do forkIO (putStrLn "Hello from the background thread!") 192 | putStrLn "Hello from the foreground thread!" 193 | 194 | 195 | -- MVars 196 | 197 | {- type MVar a 198 | 199 | newEmptyMVar :: IO (MVar a) 200 | 201 | putMVar :: MVar a -> a -> IO () 202 | 203 | takeMVar :: MVar a -> IO a 204 | -} 205 | 206 | spawnReceiver :: MVar String -> IO () 207 | spawnReceiver mvar = 208 | do forkIO (do msg <- takeMVar mvar 209 | putStrLn ("Message received: " ++ msg)) 210 | 211 | return () 212 | 213 | {- Part 9.5 : A Logging object -} 214 | 215 | data LogCommand 216 | = LogMessage String 217 | | LogStop (MVar ()) 218 | 219 | type Logger = MVar LogCommand 220 | 221 | logger :: Logger -> Int -> IO () 222 | logger loggerVar counter = 223 | do cmd <- takeMVar loggerVar 224 | case cmd of 225 | LogMessage msg -> 226 | do putStrLn ("LOG(" ++ show counter ++ "): " ++ msg) 227 | logger loggerVar (counter + 1) 228 | LogStop resp -> 229 | do putStrLn ("LOG STOPPED") 230 | putMVar resp () 231 | 232 | makeLogger :: IO Logger 233 | makeLogger = 234 | do m <- newEmptyMVar 235 | forkIO (logger m 0) 236 | return m 237 | 238 | logMessage :: Logger -> String -> IO () 239 | logMessage loggerVar msg = 240 | do putMVar loggerVar (LogMessage msg) 241 | 242 | logStop :: Logger -> IO () 243 | logStop loggerVar = 244 | do resp <- newEmptyMVar 245 | putMVar loggerVar (LogStop resp) 246 | () <- takeMVar resp 247 | return () 248 | 249 | 250 | {- Part 9.6 : Making requests in parallel -} 251 | 252 | doRequest :: Logger -> Request -> IO Response 253 | doRequest log url = 254 | do log `logMessage` ("Requesting " ++ url) 255 | httpResp <- simpleHTTP (getRequest url) 256 | body <- getResponseBody httpResp 257 | log `logMessage` ("Request " ++ url ++ " finished") 258 | return body 259 | -------------------------------------------------------------------------------- /lecture-notes/Week03Problems.hs: -------------------------------------------------------------------------------- 1 | module Week03Problems where 2 | 3 | import Data.Char 4 | 5 | {------------------------------------------------------------------------------} 6 | {- TUTORIAL QUESTIONS -} 7 | {------------------------------------------------------------------------------} 8 | 9 | {- 1. Lambda notation. 10 | 11 | Rewrite the following functions using the '\x -> e' notation (the 12 | "lambda" notation), so that they are written as 'double = 13 | ', and so on. -} 14 | 15 | mulBy2 :: Int -> Int 16 | mulBy2 x = 2*x 17 | 18 | mul :: Int -> Int -> Int 19 | mul x y = x * y 20 | 21 | invert :: Bool -> Bool 22 | invert True = False 23 | invert False = True 24 | {- HINT: use a 'case', or an 'if'. -} 25 | 26 | 27 | {- 2. Partial Application 28 | 29 | The function 'mul' defined above has the type 'Int -> Int -> 30 | Int'. (a) What is the type of the Haskell expression: 31 | 32 | mul 10 33 | 34 | (b) what is 'mul 10'? How can you use it to multiply a number? -} 35 | 36 | 37 | {- 3. Partial Application 38 | 39 | Write the 'mulBy2' function above using 'mul'. Can you make your 40 | function as short as possible? -} 41 | 42 | double_v2 :: Int -> Int 43 | double_v2 = undefined -- fill this in 44 | 45 | {- 4. Using 'map'. 46 | 47 | The function 'toUpper' takes a 'Char' and turns lower case 48 | characters into upper cases one. All other characters it returns 49 | unmodified. For example: 50 | 51 | > toUpper 'a' 52 | 'A' 53 | > toUpper 'A' 54 | 'A' 55 | 56 | Strings are lists of characters. 'map' is a function that applies a 57 | function to every character in a list and returns a new list. 58 | 59 | Write the function 'shout' that uppercases a string, so that: 60 | 61 | > shout "hello" 62 | "HELLO" 63 | -} 64 | 65 | shout :: String -> String -- remember that String = [Char] 66 | shout = undefined 67 | 68 | 69 | {- 5. Using 'map' with another function. 70 | 71 | The function 'concat' concatenates a list of lists to make one 72 | list: 73 | 74 | > concat [[1,2],[3,4],[5,6]] 75 | [1,2,3,4,5,6] 76 | 77 | Using 'map', 'concat', and either a helper function or a function 78 | written using '\', write a function 'dupAll' that duplicates every 79 | element in a list. For example: 80 | 81 | > dupAll [1,2,3] 82 | [1,1,2,2,3,3] 83 | > dupAll "my precious" 84 | "mmyy pprreecciioouuss" 85 | 86 | HINT: try writing a helper function that turns single data values 87 | into two element lists. -} 88 | 89 | dupAll :: [a] -> [a] 90 | dupAll = undefined 91 | 92 | 93 | {- 6. Using 'filter' 94 | 95 | (a) Use 'filter' to return a list consisting of only the 'E's in 96 | a 'String'. 97 | 98 | (b) Use 'onlyEs' and 'length' to count the number of 'E's in a string. 99 | 100 | (c) Write a single function that takes a character 'c' and a string 101 | 's' and counts the number of 'c's in 's'. -} 102 | 103 | onlyEs :: String -> String 104 | onlyEs = undefined 105 | 106 | numberOfEs :: String -> Int 107 | numberOfEs = undefined 108 | 109 | numberOf :: Char -> String -> Int 110 | numberOf = undefined 111 | 112 | 113 | {- 7. Rewriting 'filter' 114 | 115 | (a) Write a function that does the same thing as filter, using 116 | 'map' and 'concat'. 117 | 118 | (b) Write a function that does a 'map' and a 'filter' at the same 119 | time, again using 'map' and 'concat'. 120 | -} 121 | 122 | filter_v2 :: (a -> Bool) -> [a] -> [a] 123 | filter_v2 = undefined 124 | 125 | filterMap :: (a -> Maybe b) -> [a] -> [b] 126 | filterMap = undefined 127 | 128 | 129 | {- 8. Composition 130 | 131 | Write a function '>>>' that composes two functions. It takes two 132 | functions 'f' and 'g', and returns a function that first runs 'f' 133 | on its argument, and then runs 'g' on the result. 134 | 135 | HINT: this is similar to the function 'compose' in the notes for 136 | this week. -} 137 | 138 | (>>>) :: (a -> b) -> (b -> c) -> a -> c 139 | (>>>) = undefined 140 | 141 | {- Try rewriting the 'numberOfEs' function from above using this one. -} 142 | 143 | {- 9. Backwards application 144 | 145 | Write a function of the following type that takes a value 'x' and a 146 | function 'f' and applies 'f' to 'x'. Note that this functions takes 147 | its arguments in reverse order to normal function application! -} 148 | 149 | (|>) :: a -> (a -> b) -> b 150 | (|>) x f = undefined 151 | 152 | 153 | {- This function can be used between its arguments like so: 154 | 155 | "HELLO" |> map toLower 156 | 157 | and it is useful for chaining calls left-to-right instead of 158 | right-to-left as is usual in Haskell: 159 | 160 | "EIEIO" |> onlyEs |> length 161 | -} 162 | 163 | {- 10. Flipping 164 | 165 | Write a function that takes a two argument function as an input, 166 | and returns a function that does the same thing, but takes its 167 | arguments in reverse order: -} 168 | 169 | flip :: (a -> b -> c) -> b -> a -> c 170 | flip = undefined 171 | 172 | {- 11. Evaluating Formulas 173 | 174 | Here is a datatype describing formulas in propositional logic, as 175 | in CS208 last year. Atomic formulas are represented as 'String's. -} 176 | 177 | data Formula 178 | = Atom String 179 | | And Formula Formula 180 | | Or Formula Formula 181 | | Not Formula 182 | deriving Show 183 | 184 | {- (a) Write a function that evaluates a 'Formula' to a 'Bool'ean value, 185 | assuming that all the atomic formulas are given the value 186 | 'True'. Note that the following Haskell functions do the basic 187 | operations on 'Bool'eans: 188 | 189 | (&&) :: Bool -> Bool -> Bool -- 'AND' 190 | (||) :: Bool -> Bool -> Bool -- 'OR' 191 | not :: Bool -> Bool -- 'NOT' 192 | -} 193 | 194 | eval_v1 :: Formula -> Bool 195 | eval_v1 = undefined 196 | 197 | 198 | 199 | 200 | {- (b) Now write a new version of 'eval_v1' that, instead of evaluating 201 | every 'Atom a' to 'True', takes a function that gives a 'Bool' 202 | for each atomic proposition: -} 203 | 204 | eval :: (String -> Bool) -> Formula -> Bool 205 | eval = undefined 206 | 207 | {- For example: 208 | 209 | eval (\s -> s == "A") (Or (Atom "A") (Atom "B")) == True 210 | eval (\s -> s == "A") (And (Atom "A") (Atom "B")) == False 211 | -} 212 | 213 | {- 12. Substituting Formulas 214 | 215 | Write a function that, given a function 's' that turns 'String's 216 | into 'Formula's (a "substitution"), replaces all the atomic 217 | formulas in a Formula with whatever 'f' tells it to: -} 218 | 219 | subst :: (String -> Formula) -> Formula -> Formula 220 | subst = undefined 221 | 222 | {- For example: 223 | 224 | subst (\s -> if s == "A" then Not (Atom "A") else Atom s) (And (Atom "A") (Atom "B")) == And (Not (Atom "A")) (Atom "B") 225 | -} 226 | 227 | {- 13. Evaluating with failure 228 | 229 | The 'eval' function in 8(b) assumed that every atom could be 230 | assigned a value. But what if it can't? Write a function of the 231 | following type that takes as input a function that may or may not 232 | give a 'Bool' for each atom, and correspondingly, may or may not 233 | give a 'Bool' for the whole formula. -} 234 | 235 | evalMaybe :: (String -> Maybe Bool) -> Formula -> Maybe Bool 236 | evalMaybe = undefined 237 | -------------------------------------------------------------------------------- /lecture-notes/Week06Solutions.hs: -------------------------------------------------------------------------------- 1 | module Week06Solutions where 2 | 3 | {------------------------------------------------------------------------------} 4 | {- TUTORIAL QUESTIONS -} 5 | {------------------------------------------------------------------------------} 6 | 7 | data Tree a 8 | = Leaf 9 | | Node (Tree a) a (Tree a) 10 | deriving Show 11 | 12 | {- 1. Using 'Result' to handle errors. 13 | 14 | Here is the 'Result' type described in the notes. It is like the 15 | 'Maybe' type except that the "fail" case has a String message 16 | attached: -} 17 | 18 | data Result a 19 | = Ok a 20 | | Error String 21 | deriving (Eq, Show) 22 | 23 | {- Implement 'returnOK', 'failure', 'ifOK' and 'catch' for 'Result' 24 | instead of 'Maybe'. Note that in 'failure' we have to provide an 25 | error message, and in 'catch' the "exception handler" gets the 26 | error message. -} 27 | 28 | returnOk :: a -> Result a 29 | returnOk x = Ok x -- NOTE: because 'Ok' is like 'Just' here 30 | 31 | failure :: String -> Result a 32 | failure msg = Error msg -- NOTE: 'Error' is like 'Nothing', except that we have an error message too 33 | 34 | ifOK :: Result a -> (a -> Result b) -> Result b 35 | ifOK (Ok a) k = k a 36 | ifOK (Error msg) k = Error msg 37 | 38 | catch :: Result a -> (String -> Result a) -> Result a 39 | catch (Ok a) handler = Ok a 40 | catch (Error msg) handler = handler msg 41 | 42 | {- Reimplement 'search' to use 'Result' instead of 'Maybe'. We add 'Show 43 | k' to the requirements, so that we can put the key that wasn't 44 | found in the error message. -} 45 | 46 | search :: (Show k, Eq k) => k -> [(k,v)] -> Result v 47 | search k [] = failure ("Key '" ++ show k ++ "' not found") 48 | search k ((k',v'):kvs) = 49 | if k == k' then 50 | returnOk v' 51 | else 52 | search k kvs 53 | 54 | {- Finally, reimplement 'lookupAll v4' to return 'Result (Tree v)' 55 | instead of 'Maybe (Tree v)'. (The code will be identical!) -} 56 | 57 | lookupAll_v4 :: (Show k, Eq k) => [(k,v)] -> Tree k -> Result (Tree v) 58 | lookupAll_v4 kvs Leaf = returnOk Leaf 59 | lookupAll_v4 kvs (Node l k r) = 60 | lookupAll_v4 kvs l `ifOK` \l' -> 61 | search k kvs `ifOK` \v -> 62 | lookupAll_v4 kvs r `ifOK` \r' -> 63 | returnOk (Node l' v r') 64 | 65 | 66 | {- 2. Processes 67 | 68 | The following data type represents processes that can 'Input' lines 69 | and carry on given information about what that line is; 'Output' 70 | lines and then carry on being a process; or 'End', with a value. -} 71 | 72 | data Process a 73 | = End a 74 | | Input (String -> Process a) 75 | | Output String (Process a) 76 | 77 | {- Here is an example process, written out in full. It implements a 78 | simple interactive program: -} 79 | 80 | interaction :: Process () 81 | interaction = 82 | Output "What is your name?" 83 | (Input (\name -> 84 | Output ("Hello " ++ name ++ "!") (End ()))) 85 | 86 | {- Processes by themselves do not do anything. They are only 87 | descriptions of what to do. To have an effect on the world, we to 88 | need to translate them to Haskell's primitives for doing I/O (we 89 | will cover this in more detail in Week 08): -} 90 | 91 | runProcess :: Process a -> IO a 92 | runProcess (End a) = return a 93 | runProcess (Input k) = do line <- getLine; runProcess (k line) 94 | runProcess (Output line p) = do putStrLn line; runProcess p 95 | 96 | {- Now we can run the 'interaction' described above: 97 | 98 | > runProcess interaction 99 | What is your name? 100 | Bob <--- this line entered by the user 101 | Hello Bob! 102 | -} 103 | 104 | {- Writing out processes in the style of 'interaction' above is annoying 105 | due to the brackets needed. We can make it simpler by defining some 106 | functions, First we define two basic operations: 'input' and 107 | 'output', which are little "mini-Processes" that do one input or 108 | output operation. -} 109 | 110 | input :: Process String 111 | input = Input (\x -> End x) 112 | 113 | output :: String -> Process () 114 | output s = Output s (End ()) 115 | 116 | {- The key operation is sequencing of processes. First we (simulate) run 117 | one process, then we take the result value from that and use it to 118 | make a second process which we run. Note that this has the same 119 | flavour as the 'ifOK', 'andThen' and 'andThenWithPrinting' 120 | functions from the notes. -} 121 | 122 | sequ :: Process a -> (a -> Process b) -> Process b 123 | sequ (End a) f = f a 124 | sequ (Input k) f = Input (\x -> sequ (k x) f) 125 | sequ (Output s p) f = Output s (sequ p f) 126 | 127 | -- NOTE: why does this work? 128 | -- 129 | -- - In the 'End' case, the first process has ended with the value 130 | -- 'a', so the process we return is the second one given the value 'a'. 131 | -- 132 | -- - In the 'Input' case, the first process expects to do an input. So 133 | -- we generate a process that does an input. The anonymous function 134 | -- we use is '\x -> sequ (k x) f', which takes the input 'x', uses 135 | -- it to find out what the first process will continue to do and 136 | -- sequence 'f' after that. 137 | -- 138 | -- - In the 'Output' case, the first process expects to do an 'Output' 139 | -- of 's'. So we return a process that does that, and then carries 140 | -- on doing 'p' followed by 'f'. 141 | 142 | {- HINT: this is very very similar to the 'subst' function from Week 03. 143 | 144 | Once you have 'subst', you can define a neater version of 145 | 'interaction' that makes the sequential nature clearer: -} 146 | 147 | interaction_v2 :: Process () 148 | interaction_v2 = 149 | output "What is your name?" `sequ` \() -> 150 | input `sequ` \name -> 151 | output ("Hello " ++ name ++ "!") `sequ` \() -> 152 | End () 153 | 154 | {- Let's put sequ to work. 155 | 156 | Implement an interactive 'map' using 'input', 'output' and 157 | 'sequ'. This is a 'map' that prompts the user for what string to 158 | use to replace each string in the input list. This will be similar 159 | to printAndSum_v2 from the notes. 160 | 161 | For example: 162 | 163 | > runProcess (interactiveMap ["A","B","C"]) 164 | A 165 | a 166 | B 167 | b 168 | C 169 | c 170 | ["a","b","c"] 171 | 172 | where the lower case lines are entered by the user. -} 173 | 174 | interactiveMap :: [String] -> Process [String] 175 | interactiveMap [] = End [] 176 | interactiveMap (x:xs) = 177 | output x `sequ` \() -> 178 | input `sequ` \y -> 179 | interactiveMap xs `sequ` \ys -> 180 | End (y:ys) 181 | 182 | {- Finally, implement a function that does an 'interactive filter', 183 | similar to the interactive map. For every element in the input 184 | list, it outputs it and prompts for user input. If the user types 185 | "y" then the element is kept. Otherwise it is not copied into the 186 | output list. -} 187 | 188 | interactiveFilter :: Show a => [a] -> Process [a] 189 | interactiveFilter [] = End [] 190 | interactiveFilter (x:xs) = 191 | output ("Keep " ++ show x ++ "?") `sequ` \() -> 192 | input `sequ` \inp -> 193 | if inp == "y" then 194 | interactiveFilter xs `sequ` \ys -> 195 | End (x:ys) 196 | else 197 | interactiveFilter xs 198 | 199 | {- For example, 200 | 201 | > runProcess (interactiveFilter ["A","B","C"]) 202 | Keep "A"? 203 | y 204 | Keep "B"? 205 | n 206 | Keep "C"? 207 | y 208 | ["A","C"] 209 | 210 | -} 211 | -------------------------------------------------------------------------------- /lecture-notes/Week04Intro.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ParallelListComp #-} 2 | {-# OPTIONS_GHC -fwarn-incomplete-patterns #-} 3 | module Week04Intro where 4 | 5 | import Prelude hiding (foldr, foldl, Maybe (..), Left, Right, filter, zip, map, concat, tail) 6 | import Data.List.Split (splitOn) 7 | import Data.List hiding (foldr, foldl, filter, map, concat) 8 | 9 | {- 10 | ANNOUNCEMENT: 11 | 12 | - Week 6 class test: 13 | - Week 6: 12:00 Wednesday 26th until 12:00 Thursday 27th 14 | - should take ~ 1-2 hours 15 | - Ten questions on the material from Weeks 1 - 5 16 | - Second attempt in week 9 17 | - Worth 50% 18 | 19 | - Coursework: to be released this afternoon 20 | - Deadline at the end of the semester 21 | - Worth 50% 22 | 23 | - 2pm this afternoon: RC512 24 | - Presentations by returning internship students 25 | -} 26 | 27 | 28 | 29 | {- 30 | WEEK 04 : PATTERNS OF RECURSION 31 | 32 | 33 | 34 | -} 35 | 36 | 37 | 38 | 39 | {- Part 4.1 : FOLDING RIGHT -} 40 | 41 | -- total 42 | total :: [Int] -> Int 43 | total [] = 0 44 | total (x:xs) = x + total xs 45 | 46 | -- len 47 | len :: [a] -> Int 48 | len [] = 0 49 | len (x:xs) = 1 + len xs 50 | 51 | map_v0 :: (a -> b) -> [a] -> [b] 52 | map_v0 f [] = [] 53 | map_v0 f (x:xs) = f x : map_v0 f xs 54 | 55 | totalPlus :: Int -> [Int] -> Int 56 | totalPlus n [] = n 57 | totalPlus n (x:xs) = x + totalPlus n xs 58 | 59 | foldr :: (a -> b -> b) -> b -> [a] -> b 60 | foldr f n [] = n 61 | foldr f n (x:xs) = f x (foldr f n xs) 62 | 63 | -- data List a 64 | -- = Nil 65 | -- | Cons a (List a) 66 | 67 | -- Goal : a value of type 'b' 68 | -- Nil ~~~> n :: b 69 | -- Cons x xs ~~~> f :: a -> b -> b 70 | 71 | -- Induction: (by analogy; see the problems for this week) 72 | -- - Goal: P 73 | -- - base case: P(0) 74 | -- - step case: P(n) -> P(n + 1) 75 | 76 | -- foldr f n (1 : 2 : 3 : []) 77 | -- = f 1 (foldr f n (2 : 3 : [])) 78 | -- = f 1 (f 2 (foldr f n (3 : []))) 79 | -- = f 1 (f 2 (f 3 (foldr f n []))) 80 | -- = f 1 (f 2 (f 3 n)) 81 | -- = 1 `f` (2 `f` (3 `f` n)) 82 | -- 1 : (2 : (3 : [])) 83 | 84 | -- append 85 | 86 | append :: [a] -> [a] -> [a] 87 | append [] ys = ys 88 | append (x:xs) ys = x : append xs ys 89 | 90 | append2 :: [a] -> [a] -> [a] 91 | append2 ys [] = ys 92 | append2 ys (x:xs) = x : append2 ys xs 93 | 94 | append3 :: [a] -> [a] -> [a] 95 | append3 ys xs = foldr (\x xs -> x : xs) -- (:) -- (a -> [a] -> [a]) 96 | ys -- [a] 97 | xs 98 | 99 | append4 xs ys = foldr (:) ys xs 100 | 101 | -- append4 [1,2] [3,4] 102 | -- = foldr (:) [3,4] [1,2] 103 | -- = 1 : foldr (:) [3,4] [2] 104 | -- = 1 : 2 : foldr (:) [3,4] [] 105 | -- = 1 : 2 : [3,4] 106 | -- = [1,2,3,4] 107 | 108 | -- tail :: [a] -> [a] 109 | -- tail [] = [] 110 | -- tail (x:xs) = xs 111 | -- 112 | -- EXERCISE: How to write tail using 'foldr'? 113 | 114 | tail :: [a] -> [a] 115 | tail xs = snd (foldr (\x (ys,tail_ys) -> (x:ys, ys)) -- cons case 116 | ([],[]) -- nil case 117 | xs) 118 | 119 | -- foldr (\x (ys, tail_ys) -> (x:ys, ys)) ([],[]) [1,2,3] 120 | -- = (1:ys,tail_ys) where (ys,tail_ys) = foldr cons nil [2,3] 121 | -- = (1:ys,tail_ys) where (ys,tail_ys) = (2:zs,tail_zs) 122 | -- (zs,tail_zs) = foldr cons nil [3] 123 | -- = (1:ys,ys) where (ys,tail_ys) = (2:zs,zs) = (2:3:[], 3:[]) 124 | -- (zs,tail_zs) = (3:as,as) = (3:[], []) 125 | -- (as,tail_as) = ([],[]) 126 | -- = (1:2:3:[], 2:3:[]) 127 | 128 | 129 | map' :: (a -> b) -> [a] -> [b] 130 | map' f [] = [] 131 | map' f (x:xs) = f x : map' f xs 132 | 133 | mapFromFoldr f = foldr (\x ys -> f x : ys) [] 134 | 135 | -- filter' 136 | 137 | filter' :: (a -> Bool) -> [a] -> [a] 138 | filter' f [] = [] 139 | filter' f (x:xs) = if f x then x : filter' f xs else filter' f xs 140 | 141 | filterFromFoldr f = foldr (\x ys -> if f x then x : ys else ys) [] 142 | 143 | 144 | -- SUMMARY: 145 | -- - foldr is a way of abstracting the idea of recursion on a list 146 | -- - "nearly every" function on lists can be expressed as a foldr 147 | -- - but it is not necessarily a good idea 148 | -- - very related to the "Visitor Pattern" in OO languages 149 | 150 | 151 | {- Part 4.2 : FOLDING LEFT -} 152 | 153 | {- 154 | foldr f a [x1,x2,x3] 155 | == f x1 (foldr f a [x2,x3]) 156 | == f x1 (f x2 (foldr f a [x3])) 157 | == f x1 (f x2 (f x3 (foldr f a []))) 158 | == f x1 (f x2 (f x3 a)) 159 | == x1 `f` (x2 `f` (x3 `f` a)) 160 | 161 | what about: 162 | 163 | ((a `f` x1) `f` x2) `f` x3 164 | 165 | result = 0 166 | for (String a : strings) { 167 | result = f(result, a.length()); 168 | } 169 | -} 170 | 171 | foldl :: (b -> a -> b) -> b -> [a] -> b 172 | foldl f accumulator [] = accumulator 173 | foldl f accumulator (x:xs) = foldl f (f accumulator x) xs 174 | 175 | -- foldl (\xs x -> x : xs) [] [1,2,3] 176 | -- = foldl (\xs x -> x : xs) (1 : []) [2,3] 177 | -- = foldl (\xs x -> x : xs) (2 : 1 : []) [3] 178 | -- = foldl (\xs x -> x : xs) (3 : 2 : 1 : []) [] 179 | -- = (3 : 2 : 1 : []) 180 | -- = [3,2,1] 181 | 182 | {- 183 | ArrayList list = new ArrayList(); 184 | for (String a : strings) { 185 | list.prepend(a); 186 | } 187 | return list; 188 | -} 189 | 190 | -- SUMMARY: 191 | -- - foldl is the 'accumulator' version of foldr 192 | -- - useful for simulating stateful traversals of a list 193 | -- - tutorial question: implement foldl in terms of foldr 194 | 195 | {- Part 4.3 : FOLD FOR OTHER TYPES -} 196 | 197 | data List a = Nil | Cons a (List a) 198 | 199 | data ListC a b = NilC | ConsC a b 200 | 201 | -- type List a = ListC a (List a) 202 | 203 | -- Nil ~~> nil :: b 204 | -- Cons x xs ~~> cons :: a -> b -> b 205 | 206 | -- foldr :: (a -> b -> b) -> b -> [a] -> b' 207 | 208 | data Tree a 209 | = Leaf 210 | | Node (Tree a) a (Tree a) 211 | deriving Show 212 | 213 | -- Leaf ~~> leaf :: b 214 | -- Node l x r ~~> node :: b -> a -> b -> b 215 | 216 | foldTree :: b -> (b -> a -> b -> b) -> Tree a -> b 217 | foldTree leaf node Leaf = leaf 218 | foldTree leaf node (Node l x r) = node (foldTree leaf node l) x (foldTree leaf node r) 219 | 220 | -- Node (Node Leaf 1 Leaf) 2 (Node Leaf 3 Leaf) 221 | -- node (node leaf 1 leaf) 2 (node leaf 3 leaf) 222 | 223 | -- add (add 0 1 0) 2 (add 0 3 0) 224 | 225 | 226 | sumtree = foldTree 0 (\sum_l x sum_r -> sum_l + x + sum_r) 227 | 228 | data Expr 229 | = Const Int 230 | | Add Expr Expr 231 | | Sub Expr Expr 232 | | Mul Expr Expr 233 | deriving Show 234 | 235 | foldExpr :: (Int -> b) -> (b -> b -> b) -> (b -> b -> b) -> (b -> b -> b) -> Expr -> b 236 | foldExpr const add sub mul (Const i) = const i 237 | foldExpr const add sub mul (Add e1 e2) = 238 | add (foldExpr const add sub mul e1) (foldExpr const add sub mul e2) 239 | foldExpr const add sub mul (Sub e1 e2) = 240 | sub (foldExpr const add sub mul e1) (foldExpr const add sub mul e2) 241 | foldExpr const add sub mul (Mul e1 e2) = 242 | mul (foldExpr const add sub mul e1) (foldExpr const add sub mul e2) 243 | 244 | eval = foldExpr (\i -> i) (+) (-) (*) 245 | 246 | printExpr = foldExpr (\i -> show i) 247 | (\e1 e2 -> "(" ++ e1 ++ " + " ++ e2 ++ ")") 248 | (\e1 e2 -> "(" ++ e1 ++ " - " ++ e2 ++ ")") 249 | (\e1 e2 -> "(" ++ e1 ++ " * " ++ e2 ++ ")") 250 | {- SUMMARY 251 | 252 | - Folds are more general than just lists 253 | - Generic way of describing how to "visit" values of a datatype 254 | - In the notes: fold for the Maybe type 255 | 256 | - 'reduce' in other languages 257 | - from functools import reduce 258 | - reduce(lambda x y: x + y, 0, [1,2,3,4]) -- Python 259 | -} 260 | 261 | 262 | {- Part 4.4 : LIST COMPREHENSIONS -} 263 | 264 | list1 = 1 : (2 : (3 : (4 : []))) 265 | 266 | list2 = [1,2,3,4] 267 | 268 | list3 = [ x * x | x <- [1,2,3,4,5,6] ] 269 | 270 | -- Python: [ x * x for x in [1,2,3,4,5,6] ] 271 | 272 | list4 = [ x * y | x <- [1,2,3,4,5,6], y <- [1..x]] 273 | 274 | library = [ ("Alice", "A Christmas Carol"), 275 | ("Bob", "Tinker Tailor Soldier Spy"), 276 | ("Carol", "Alice in Wonderland") ] 277 | 278 | late = ["Alice", "Carol"] 279 | 280 | dueBooks = [ book | 281 | (person, book) <- library, 282 | late_person <- late, 283 | person == late_person, 284 | person !! 0 == 'C'] 285 | 286 | -- (!!) : [a] -> Int -> a 287 | 288 | 289 | 290 | -- { x | x in X, x > 5 } 291 | 292 | -- SELECT book 293 | -- FROM Library, Late 294 | -- WHERE Library.Person = Late.Person 295 | -------------------------------------------------------------------------------- /lecture-notes/Week08Intro.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -fwarn-incomplete-patterns #-} 2 | {-# LANGUAGE InstanceSigs #-} 3 | module Week08Intro where 4 | 5 | import Data.Char (toUpper, isDigit, digitToInt, isSpace) 6 | import Data.Foldable (for_) 7 | import Data.IORef (IORef, newIORef, readIORef, 8 | writeIORef, modifyIORef) 9 | import Control.Exception (finally) 10 | import System.IO (openFile, hPutChar, hGetChar, 11 | hClose, IOMode (..), hIsEOF, Handle) 12 | 13 | {- WEEK 8 : REAL I/O and PARSER COMBINATORS -} 14 | 15 | 16 | 17 | {- Part 8.1 : I/O Conceptually 18 | 19 | 20 | A great philosopher once wrote: 21 | 22 | The philosophers have only interpreted the world, in various 23 | ways. The point, however, is to change it. 24 | 25 | -- Karl Marx ( https://en.wikipedia.org/wiki/Theses_on_Feuerbach ) 26 | -} 27 | 28 | -- Equational reasoning in the presence of IO 29 | 30 | -- putChar :: Char -> IO () 31 | -- void putc(char c) -- C 32 | 33 | -- f x = (putChar x, putChar x) 34 | 35 | -- f x = (y,y) 36 | -- where y = putChar x 37 | 38 | -- f x = let y = putChar x in 39 | -- (y,y) 40 | 41 | -- IO a 42 | 43 | 44 | -- IOAction a 45 | 46 | data IOAction a 47 | = Return a 48 | | PutChar Char (IOAction a) 49 | | GetChar (Char -> IOAction a) 50 | -- Conceptually, this is what 'IO a' looks like 51 | -- except that there are many, many more things that IO can do 52 | 53 | getChar' = GetChar (\c -> Return c) 54 | 55 | -- IO a 56 | 57 | {- Part 8.2 : Doing I/O in Haskell -} 58 | 59 | -- putChar :: Char -> IO () 60 | -- getChar :: IO Char 61 | 62 | putLine :: String -> IO () 63 | putLine str = do for_ str (\c -> putChar c) 64 | putChar '\n' 65 | 66 | readLine :: IO String 67 | readLine = do c <- getChar 68 | if c == '\n' then return "" 69 | else do cs <- readLine 70 | return (c:cs) 71 | 72 | {- Part 8.5 : Parser Combinators -} 73 | 74 | -- What is parsing? 75 | 76 | -- - Turning a sequence of bytes into structured representation 77 | 78 | -- - {"a\"a\"" : 1, "b": true, "c": 5} 79 | 80 | -- Sequence of bytes (0-255) 81 | -- Encoded in the bytes are unicode codepoint (0-2^21-1) 82 | -- We don't need to worry about this. Haskell (and most other languages will decode automatically) 83 | 84 | type Parser_v1 a = String -> Maybe a 85 | 86 | -- parsing booleans 87 | parseBool_v1 :: Parser_v1 Bool 88 | parseBool_v1 "True" = Just True 89 | parseBool_v1 "False" = Just False 90 | parseBool_v1 _ = Nothing 91 | 92 | -- True,False 93 | 94 | -- parsing booleans 95 | parseBool :: Parser Bool 96 | parseBool = MkParser (\input -> case input of 97 | 'T':'r':'u':'e':rest -> Just (True, rest) 98 | 'F':'a':'l':'s':'e':rest -> Just (False, rest) 99 | _ -> Nothing) 100 | 101 | -- parsePair 102 | parsePair :: Parser a -> Parser b -> Parser (a,b) 103 | parsePair (MkParser pa) (MkParser pb) = 104 | MkParser (\input -> case pa input of 105 | Nothing -> Nothing 106 | Just (a, rest) -> 107 | case pb rest of 108 | Nothing -> Nothing 109 | Just (b, rest2) -> 110 | Just ((a,b), rest2)) 111 | 112 | parseComma :: Parser () 113 | parseComma = MkParser (\input -> case input of 114 | ',':rest -> Just ((), rest) 115 | _ -> Nothing) 116 | 117 | newtype Parser a = MkParser (String -> Maybe (a, String)) 118 | 119 | runParser :: Parser a -> String -> Maybe (a, String) 120 | runParser (MkParser p) = p 121 | 122 | 123 | -- Monad: 'return' and '>>=' 124 | 125 | -- 'orElse', and 'fail' 126 | 127 | -- char 128 | 129 | instance Monad Parser where 130 | return x = MkParser (\input -> Just (x, input)) 131 | 132 | MkParser p >>= k = 133 | MkParser (\input -> 134 | case p input of 135 | Nothing -> Nothing 136 | Just (a, input') -> 137 | case k a of 138 | MkParser p2 -> 139 | p2 input') 140 | 141 | instance Applicative Parser where 142 | pure = return 143 | pf <*> pa = do f <- pf; a <- pa; return (f a) 144 | 145 | instance Functor Parser where 146 | fmap f p = pure f <*> p 147 | 148 | orElse :: Parser a -> Parser a -> Parser a 149 | orElse (MkParser p1) (MkParser p2) = 150 | MkParser (\input -> 151 | case p1 input of 152 | Nothing -> p2 input 153 | Just (a,input') -> Just (a,input')) 154 | 155 | failParse :: Parser a 156 | failParse = MkParser (\input -> Nothing) 157 | 158 | -- p `orElse` fail == fail `orElse` p == p 159 | 160 | char :: Parser Char 161 | char = MkParser (\input -> case input of 162 | c:input' -> Just (c, input') 163 | [] -> Nothing) 164 | 165 | ------------------------------------------------------------------------------ 166 | 167 | isChar :: Char -> Parser () 168 | isChar expected = 169 | do got <- char 170 | if got == expected then return () else failParse 171 | 172 | parseTrue :: Parser Bool 173 | parseTrue = 174 | do isString "True" 175 | return True 176 | 177 | parseFalse :: Parser Bool 178 | parseFalse = 179 | do isString "False" 180 | return False 181 | 182 | isString :: String -> Parser () 183 | isString expected = for_ expected (\c -> isChar c) 184 | 185 | parseBoolean :: Parser Bool 186 | parseBoolean = parseTrue `orElse` parseFalse 187 | 188 | listOfBooleans :: Parser [Bool] 189 | listOfBooleans = 190 | (do b <- parseBoolean 191 | isString "," 192 | bs <- listOfBooleans 193 | return (b:bs)) 194 | `orElse` 195 | (do b <- parseBoolean 196 | return [b]) 197 | 198 | sepBy1 :: Parser () -> Parser a -> Parser [a] 199 | sepBy1 pSep pValue = 200 | (do b <- pValue 201 | pSep 202 | bs <- sepBy pSep pValue 203 | return (b:bs)) 204 | `orElse` 205 | (do b <- pValue 206 | return [b]) 207 | 208 | sepBy :: Parser () -> Parser a -> Parser [a] 209 | sepBy pSep pValue = sepBy1 pSep pValue `orElse` return [] 210 | 211 | -- JSON : JavaScript Object Notation 212 | 213 | data JSON 214 | = Number Int -- 12, 45645, 0 215 | | Bool Bool -- true, false 216 | | Null -- null 217 | | String String -- "hello \"world\"" "\"hello \\\"world\\\"\"" 218 | | Array [JSON] -- [ 1, true, null, "a", [1,2,3] ] 219 | | Object [(String,JSON)] -- { "hello": [1,2], "field": null } 220 | deriving Show 221 | 222 | 223 | parseJSONBool :: Parser Bool 224 | parseJSONBool = 225 | do isString "true" 226 | return True 227 | `orElse` 228 | do isString "false" 229 | return False 230 | 231 | parseJSONNull :: Parser () 232 | parseJSONNull = 233 | isString "null" 234 | 235 | 236 | parseStringChar :: Parser Char 237 | parseStringChar = 238 | do c <- char 239 | case c of 240 | '"' -> failParse 241 | '\\' -> do c <- char 242 | return c 243 | c -> return c 244 | 245 | zeroOrMore :: Parser a -> Parser [a] 246 | zeroOrMore p = 247 | do x <- p 248 | xs <- zeroOrMore p 249 | return (x:xs) 250 | `orElse` 251 | return [] 252 | 253 | parseString :: Parser String 254 | parseString = do 255 | isChar '"' 256 | content <- zeroOrMore parseStringChar 257 | isChar '"' 258 | return content 259 | 260 | parseArray :: Parser a -> Parser [a] 261 | parseArray pValue = 262 | do isChar '[' 263 | items <- sepBy (isChar ',') pValue 264 | isChar ']' 265 | return items 266 | 267 | parseObject :: Parser a -> Parser [(String,a)] 268 | parseObject pValue = 269 | do isChar '{' 270 | items <- sepBy (isChar ',') (do fieldname <- parseString 271 | isChar ':' 272 | value <- pValue 273 | return (fieldname, value)) 274 | isChar '}' 275 | return items 276 | 277 | parseJSON :: Parser JSON 278 | parseJSON = 279 | do b <- parseJSONBool 280 | return (Bool b) 281 | `orElse` 282 | do parseJSONNull 283 | return Null 284 | `orElse` 285 | do str <- parseString 286 | return (String str) 287 | `orElse` 288 | do items <- parseArray parseJSON 289 | return (Array items) 290 | `orElse` 291 | do items <- parseObject parseJSON 292 | return (Object items) 293 | 294 | testInput = "{\"a\":true,\"b\":[false,null,\"c\"]}" 295 | 296 | -- Now we should be able to parse JSON: 297 | -- 298 | -- > runParser parseJSON testInput 299 | -- Just (Object [("a",Bool True),("b",Array [Bool False,Null,String "c"])],"") 300 | -------------------------------------------------------------------------------- /lecture-notes/Week01Solutions.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -fwarn-incomplete-patterns #-} 2 | module Week01Solutions where 3 | 4 | import Week01 5 | import Prelude hiding (take, drop, Left, Right, Maybe (..), reverse, length) 6 | 7 | {----------------------------------------------------------------------} 8 | {- Tutorial Questions -} 9 | {----------------------------------------------------------------------} 10 | 11 | {- In the questions below, replace 'undefined' with your answers. Use 12 | GHCi to test them.-} 13 | 14 | {- 1. Write a function: -} 15 | 16 | isHorizontal :: Direction -> Bool 17 | isHorizontal Up = False 18 | isHorizontal Down = False 19 | isHorizontal Left = True 20 | isHorizontal Right = True 21 | 22 | {- We could also write: 23 | 24 | isHorizontal Up = False 25 | isHorizontal Down = False 26 | isHorizontal _ = True 27 | 28 | or 29 | 30 | isHorizontal Left = True 31 | isHorizontal Right = True 32 | isHorizontal _ = False 33 | 34 | -} 35 | 36 | {- that returns 'True' if the direction is 'Left' or 'Right', and 37 | 'False' otherwise. -} 38 | 39 | 40 | {- 2. Write a function: -} 41 | 42 | flipHorizontally :: Direction -> Direction 43 | flipHorizontally Left = Right 44 | flipHorizontally Right = Left 45 | flipHorizontally x = x 46 | 47 | {- that flips horizontally (Left <-> Right, Up and Down stay the same). -} 48 | 49 | {- Could also write: 50 | 51 | flipHorizontally Left = Right 52 | flipHorizontally Right = Left 53 | flipHorizontally Up = Up 54 | flipHorizontally Down = Down 55 | -} 56 | 57 | 58 | {- 3. Rewrite 'equalDirections' to take a 'Pair Direction Direction' as 59 | input: -} 60 | 61 | pairOfEqualDirections :: Pair Direction Direction -> Bool 62 | pairOfEqualDirections (MkPair Up Up) = True 63 | pairOfEqualDirections (MkPair Down Down) = True 64 | pairOfEqualDirections (MkPair Left Left) = True 65 | pairOfEqualDirections (MkPair Right Right) = True 66 | pairOfEqualDirections (MkPair _ _) = False 67 | 68 | {- 4. Define a datatype 'Triple a b c' for values that have three 69 | components. Write functions 'get1of3 :: Triple a b c -> a', 70 | 'get2of3' and 'get3of3' that return the first, second and third 71 | components. You will have to come up with the type signatures 72 | for the second and third one. -} 73 | 74 | data Triple a b c = MkTriple a b c 75 | deriving Show 76 | 77 | get1of3 :: Triple a b c -> a 78 | get1of3 (MkTriple a b c) = a 79 | 80 | get2of3 :: Triple a b c -> b 81 | get2of3 (MkTriple a b c) = b 82 | 83 | get3of3 :: Triple a b c -> c 84 | get3of3 (MkTriple a b c) = c 85 | 86 | {- 5. Pattern matching on specific characters is done by writing the 87 | character to match. For example: -} 88 | 89 | isA :: Char -> Bool 90 | isA 'A' = True 91 | isA _ = False 92 | 93 | {- Write a function 'dropSpaces' :: [Char] -> [Char]' that drops 94 | spaces from the start of a list of characters. For example, we 95 | should have: 96 | 97 | *Week01> dropSpaces " hello" 98 | "hello" 99 | 100 | (Strings in Haskell are really lists of 'Char's) -} 101 | 102 | dropSpaces :: [Char] -> [Char] 103 | dropSpaces [] = [] 104 | dropSpaces (' ':xs) = dropSpaces xs 105 | dropSpaces xs = xs 106 | 107 | {- Alternatively: 108 | 109 | dropSpaces [] = [] 110 | dropSpaces (x:xs) = if x == ' ' then dropSpaces xs else (x:xs) 111 | 112 | or 113 | 114 | dropSpaces [] = [] 115 | dropSpaces (x:xs) 116 | | x == ' ' = dropSpaces xs 117 | | otherwise = (x:xs) 118 | -} 119 | 120 | {- 6. Using 'reverse' and 'dropSpaces', write a function that removes 121 | spaces at the *end* of a list of characters. For example: 122 | 123 | *Week10> dropTrailingSpaces "hello " 124 | "hello" 125 | -} 126 | 127 | dropTrailingSpaces :: [Char] -> [Char] 128 | dropTrailingSpaces xs = reverse (dropSpaces (reverse xs)) 129 | 130 | {- Alternatively, using knowledge from Week 03: 131 | 132 | dropTrailingSpaces = reverse . dropSpaces . reverse 133 | 134 | -} 135 | 136 | {- 7. HTML escaping. When writing HTML, the characters '<', '&', and '>' 137 | are special because they are used to represent tags and 138 | entities. To have these characters display properly as 139 | themselves in HTML they need to be replaced by their entity 140 | versions: 141 | 142 | '<' becomes '<' ("less than") 143 | '>' becomes '>' ("greater than") 144 | '&' becomes '&' ("ampersand") 145 | 146 | Write a function that performs this replacement on a string. You 147 | should have, for example, 148 | 149 | Week01Problems*> htmlEscape "" 150 | "<not a tag>" 151 | -} 152 | 153 | htmlEscape :: String -> String 154 | htmlEscape "" = "" 155 | htmlEscape ('<':cs) = "<" ++ htmlEscape cs 156 | htmlEscape ('&':cs) = "&" ++ htmlEscape cs 157 | htmlEscape ('>':cs) = ">" ++ htmlEscape cs 158 | htmlEscape (c:cs) = c : htmlEscape cs 159 | 160 | {- 8. The following datatype represents a piece of text marked up with 161 | style information. -} 162 | 163 | data Markup 164 | = Text String -- ^ Some text 165 | | Bold Markup -- ^ Some markup to be styled in bold 166 | | Italic Markup -- ^ Some markup to be styled in italics 167 | | Concat Markup Markup -- ^ Two pieces of markup to be displayed in sequence 168 | 169 | {- Here is an example: -} 170 | 171 | exampleMarkup :: Markup 172 | exampleMarkup = Concat (Bold (Text "Delays")) (Concat (Text " are ") (Italic (Text "possible"))) 173 | 174 | {- Writing markup like this is tedious, especially when there are 175 | lots of 'Concat's. Write a function that takes a list of 176 | 'Markup's and concatenates them all together using 'Concat'. -} 177 | 178 | catMarkup :: [Markup] -> Markup 179 | catMarkup [] = Text "" 180 | catMarkup (m:ms) = Concat m (catMarkup ms) 181 | 182 | {- NOTE: There is no constructor for 'Markup' that directly 183 | represents an empty piece of Markup. I have used 'Text ""' to 184 | represent empty markup. Another possibility would be to add a 185 | constructor 'Empty' to the 'Markup' type. -} 186 | 187 | {- Another way of making the writing of Markup easier is the 188 | automatic insertion of spaces. Write another function that 189 | concatenates a list of 'Markup's putting spaces between them: -} 190 | 191 | catMarkupSpaced :: [Markup] -> Markup 192 | catMarkupSpaced [] = Text "" 193 | catMarkupSpaced [m] = m 194 | catMarkupSpaced (m:ms) = Concat m (Concat (Text " ") (catMarkupSpaced ms)) 195 | 196 | {- NOTE: Notice that this function matches specially on the single 197 | element list. This allows us to place spaces (i.e. 'Text " "') 198 | _between_ each element of the input list. 199 | 200 | Another way to write this function would be to do it in two 201 | stages. First take the original input list and place 'Text " "' 202 | between each element. This can either be done by writing a new 203 | function, or by using the 'intersperse' function from the 204 | 'Data.List' module. Then the resulting list can be concatenated 205 | using the 'catMarkup' function defined above. -} 206 | 207 | {- Sometimes we want to remove all formatting from a piece of 208 | text. Write a function that removes all 'Bold' and 'Italic' 209 | instructions from a piece of Markup, replacing them with their 210 | underlying plain markup. 211 | 212 | For example: 213 | 214 | Week01Problems*> removeStyle exampleMarkup 215 | Concat (Text "Delays") (Concat (Text " are ") (Text "possible")) 216 | -} 217 | 218 | removeStyle :: Markup -> Markup 219 | removeStyle (Text s) = Text s 220 | removeStyle (Bold m) = removeStyle m 221 | removeStyle (Italic m) = removeStyle m 222 | removeStyle (Concat m1 m2) = Concat (removeStyle m1) (removeStyle m2) 223 | 224 | {- Finally, we can 'render' our markup to HTML. Write a function that 225 | converts 'Markup' to its HTML string representation, using 226 | '..' for bold and '...' for 227 | italics. Use the 'htmEscape' function from above to make sure 228 | that 'Text' nodes are correctly converted to HTML. 229 | 230 | For example: 231 | 232 | Week01Problems*> markupToHTML exampleMarkup 233 | "Delays are possible" 234 | 235 | and 236 | 237 | Week01Problems*> markupToHTML (Bold (Text "<&>")) 238 | "<&>" 239 | -} 240 | 241 | markupToHTML :: Markup -> String 242 | markupToHTML (Text s) = htmlEscape s 243 | markupToHTML (Bold m) = "" ++ markupToHTML m ++ "" 244 | markupToHTML (Italic m) = "" ++ markupToHTML m ++ "" 245 | markupToHTML (Concat m1 m2) = markupToHTML m1 ++ markupToHTML m2 246 | -------------------------------------------------------------------------------- /lecture-notes/Week06Intro.hs: -------------------------------------------------------------------------------- 1 | module Week06Intro where 2 | 3 | -- REMEMBER: 4 | -- - Test **tomorrow** Wednesday 26th 12:00 ---> Thursday 27th 12:00 5 | -- - 10 questions on weeks 1-5 6 | -- - should take ~1-2hrs 7 | -- - counts for 50% 8 | -- - redemption test in Week 9 9 | -- - UG Placement presentations GH514 Wednesday 14:00-16:00 GH514 10 | 11 | 12 | {- WEEK 06 : SIMULATING SIDE EFFECTS 13 | 14 | Haskell doesn't have "side effects" or is "pure". 15 | - What does this mean? 16 | - Is it a good thing? 17 | 18 | In Haskell: 19 | 20 | f :: Int -> Int 21 | 22 | what can it do? 23 | 24 | - Not terminate (or crash with an unrecoverable error) 25 | - Or it can return an Int 26 | - if we give it the same input twice, we'll get the same answer 27 | 28 | 29 | In Java: 30 | 31 | public static int f(int x) 32 | 33 | what can it do? 34 | 35 | - Non terminate 36 | - throw an Exception 37 | - return an int 38 | - print things to the screen 39 | - generate random numbers 40 | - read files 41 | - make network calls 42 | - posting cat pictures to 43 | - buy things on amazon 44 | - launch nuclear missiles 45 | 46 | How do we make Haskell do these things? 47 | -} 48 | 49 | 50 | {- Part 6.1 : Simulating Exceptions -} 51 | 52 | {- data Maybe a = Nothing | Just a -} 53 | 54 | returnOk :: a -> Maybe a 55 | returnOk x = Just x 56 | 57 | failure :: Maybe a -- throw new Exception(); 58 | failure = Nothing 59 | 60 | search :: Eq k => k -> [(k,v)] -> Maybe v 61 | search k [] = failure 62 | search k ((k',v):kvs) = if k == k' then returnOk v else search k kvs 63 | 64 | lookupList :: Eq k => [k] -> [(k,v)] -> Maybe [v] 65 | lookupList [] kvs = returnOk [] 66 | lookupList (k:ks) kvs = 67 | case search k kvs of 68 | Nothing -> Nothing 69 | Just v -> 70 | case lookupList ks kvs of 71 | Nothing -> Nothing 72 | Just vs -> 73 | returnOk (v:vs) 74 | 75 | ifOK :: Maybe a -> (a -> Maybe b) -> Maybe b 76 | ifOK Nothing k = Nothing 77 | ifOK (Just a) k = k a 78 | 79 | lookupList_v2 :: Eq k => [k] -> [(k,v)] -> Maybe [v] 80 | lookupList_v2 [] kvs = returnOk [] 81 | lookupList_v2 (k:ks) kvs = 82 | search k kvs `ifOK` (\v -> 83 | lookupList_v2 ks kvs `ifOK` (\vs -> 84 | returnOk (v:vs))) 85 | 86 | -- "ifOK" is basically the semicolon 87 | 88 | -- What if we could reprogram the semicolon ? 89 | 90 | -- How to simulate 'catch' 91 | 92 | -- data Either a b = Left a | Right b 93 | -- data Result a = Ok a | Error String 94 | 95 | {- Part 6.2 : Simulating (Mutable) State -} 96 | 97 | {- We can make updatable state 'pure' by making fresh names for 98 | variables instead of treating each variable as a thing that can 99 | change. 100 | 101 | int i0 = 0; 102 | 103 | int i1 = 10; 104 | 105 | int i2 = i1 + 1; 106 | 107 | ... 108 | 109 | int i3 = i2 - 1; 110 | 111 | -- this is the form that compilers use internally when compiling most languages 112 | -- SSA (Static Single Assignment) 113 | -} 114 | 115 | {- output = new LinkedList>(); 116 | int i = 0; 117 | for (String x : xs) { 118 | Pair<> p = new Pair(i, x); 119 | output.append(p); 120 | i++; 121 | } 122 | -} 123 | 124 | numberList :: [a] -> Int -> (Int, [(a,Int)]) 125 | numberList [] i = (i, []) 126 | numberList (x:xs) i = 127 | let p = (x,i) 128 | i0 = i + 1 129 | (i1, ys) = numberList xs i0 130 | in (i1, p:ys) 131 | 132 | -- State type 133 | type State a = Int -> (Int, a) 134 | 135 | returnSt :: a -> State a 136 | -- a -> Int -> (Int, a) 137 | returnSt x i = (i, x) 138 | 139 | andThen :: State a -> (a -> State b) -> State b 140 | -- (Int -> (Int, a)) -> (a -> Int -> (Int, b)) -> Int -> (Int, b) 141 | andThen computation1 k i = 142 | let (i0, a) = computation1 i 143 | (i1, b) = k a i0 144 | in (i1, b) 145 | 146 | get :: State Int 147 | -- Int -> (Int, Int) 148 | get i = (i, i) 149 | 150 | put :: Int -> State () 151 | -- Int -> Int -> (Int, ()) 152 | put newstate currentstate = (newstate, ()) 153 | 154 | numberList_v2 :: [a] -> State [(a,Int)] 155 | numberList_v2 [] = returnSt [] 156 | numberList_v2 (x:xs) = 157 | get `andThen` (\i -> 158 | put (i+1) `andThen` (\() -> 159 | numberList_v2 xs `andThen` (\ys -> 160 | returnSt ((x,i) : ys)))) 161 | 162 | 163 | -- Simulating exceptions with 'Maybe' -- 'Nothing' means 'throw an exception' 164 | -- 'Just a' means 'return a' 165 | 166 | -- returnOk :: a -> Maybe a 167 | -- returnSt :: a -> State a 168 | 169 | -- ifOK :: Maybe a -> (a -> Maybe b) -> Maybe b 170 | -- andThen :: State a -> (a -> State b) -> State b 171 | 172 | -- "do this and, with the result, do the next thing" 173 | 174 | 175 | 176 | {- Part 6.4 : SIMULATING PRINTING (or OUTPUT) -} 177 | 178 | data Tree a 179 | = Leaf 180 | | Node (Tree a) a (Tree a) 181 | deriving (Eq, Show) 182 | 183 | printAndSum :: Tree Int -> ([String], Int) 184 | printAndSum Leaf = 185 | ([], 0) 186 | printAndSum (Node l x r) = 187 | let (out1, lsum) = printAndSum l 188 | out = ["Doing " ++ show x] 189 | (out2, rsum) = printAndSum r 190 | in (out1 ++ out ++ out2, lsum + x + rsum) 191 | 192 | testTree :: Tree Int 193 | testTree = Node (Node Leaf 4 Leaf) 7 (Node Leaf 9 Leaf) 194 | 195 | data Printing a = MkPrinting [String] a 196 | deriving Show 197 | 198 | returnPr :: a -> Printing a 199 | returnPr x = MkPrinting [] x 200 | 201 | andThenPrinting :: Printing a -> (a -> Printing b) -> Printing b 202 | -- first job which may print 'output1' and return 'a' 203 | -- second job requires an 'a', may print 'output2' and return 'b' 204 | -- output1 ++ output2, return 'b' 205 | andThenPrinting (MkPrinting output1 a) k = 206 | case k a of 207 | MkPrinting output2 b -> 208 | MkPrinting (output1 ++ output2) b 209 | 210 | 211 | printAndSum_v2 :: Tree Int -> Printing Int 212 | printAndSum_v2 Leaf = 213 | returnPr 0 214 | -- ([], 0) 215 | printAndSum_v2 (Node l x r) = 216 | printAndSum_v2 l `andThenPrinting` 217 | (\lsum -> 218 | printStr ("Doing " ++ show x) `andThenPrinting` 219 | (\() -> 220 | printAndSum_v2 r `andThenPrinting` 221 | (\rsum -> 222 | returnPr (lsum + x + rsum)))) 223 | 224 | printStr :: String -> Printing () 225 | printStr s = MkPrinting [s] () 226 | 227 | -- Another example of "do this, then do that" 228 | 229 | 230 | {- Part 6.5 : PROCESSES -} 231 | 232 | data Process a 233 | = End a 234 | | Input (String -> Process a) 235 | | Output String (Process a) 236 | 237 | example :: Process () 238 | example = 239 | Output "What is your name?" 240 | (Input (\input -> 241 | Output ("Hello " ++ input) 242 | (End ()))) 243 | 244 | 245 | runProcess :: Process a -> IO a 246 | runProcess (End a) = return a 247 | runProcess (Input k) = do s <- getLine; runProcess (k s) 248 | runProcess (Output s p) = do putStrLn s; runProcess p 249 | 250 | returnProcess :: a -> Process a 251 | returnProcess x = End x 252 | 253 | {- 254 | Input 255 | / | \ 256 | Output "a" End 5 Output "b" 257 | | | 258 | End 1 End 4 259 | -} 260 | 261 | {- \i -> Output (show i) (End ()) -} 262 | 263 | {- 264 | Input 265 | / | \ 266 | Output "a" Output "5" Output "b" 267 | | | | 268 | Output "1" End () Output "4" 269 | | | 270 | End () End () 271 | 272 | -} 273 | 274 | 275 | process1 = Input (\input -> 276 | if input == "a" then Output "a" (End 1) 277 | else if input == "b" then End 5 278 | else Output "b" (End 4)) 279 | 280 | process2 i = Output (show i) (End ()) 281 | 282 | sequ :: Process a -> (a -> Process b) -> Process b 283 | sequ (End a) k = k a 284 | sequ (Input p) k = Input (\s -> sequ (p s) k) 285 | sequ (Output s p) k = Output s (sequ p k) 286 | 287 | output :: String -> Process () 288 | output s = Output s (End ()) 289 | 290 | input :: Process String 291 | input = Input (\s -> End s) 292 | 293 | example_v2 :: Process () 294 | example_v2 = 295 | output "What is your name?" `sequ` \() -> 296 | input `sequ` \str -> 297 | output ("Hello " ++ str) `sequ` \() -> 298 | returnProcess () 299 | 300 | 301 | -- Four ways of "simulating side effects" 302 | -- 303 | -- All have similar interfaces: 304 | -- 305 | -- ifOK :: Maybe a -> (a -> Maybe b) -> Maybe b 306 | -- andThen :: State a -> (a -> State b) -> State b 307 | -- andThenPrinting :: Printing a -> (a -> Printing b) -> Printing b 308 | -- sequ :: Process a -> (a -> Process b) -> Process b 309 | 310 | 311 | -- The common name is "Monad" 312 | 313 | -- class Monad m where 314 | -- return :: a -> m a 315 | -- (>>=) :: m a -> (a -> m b) -> m b 316 | -------------------------------------------------------------------------------- /lecture-notes/Week05Problems.hs: -------------------------------------------------------------------------------- 1 | module Week05Problems where 2 | 3 | import Data.Foldable 4 | import Data.Monoid 5 | import Data.Bits (FiniteBits(countLeadingZeros)) 6 | 7 | {------------------------------------------------------------------------------} 8 | {- TUTORIAL QUESTIONS -} 9 | {------------------------------------------------------------------------------} 10 | 11 | {- 1. Define a 'Show' instance for the following datatype that prints 12 | out the data in a JSON-like format. For example, 13 | 14 | show (MkHost "www.cis.strath.ac.uk" 80) == "{\"name\":\"www.cis.strath.ac.uk\", \"port\": 80}" 15 | 16 | The backslashes before the '"'s in the string are "escape 17 | characters". They are there so that Haskell knows not to end the 18 | string at this point. 19 | -} 20 | 21 | data Host = MkHost String Int 22 | 23 | instance Show Host where 24 | show = undefined 25 | 26 | 27 | 28 | {- 2. Define an 'Eq' instance for the following datatype that makes two 29 | numbers equal if they have the same remainder after division by 30 | 12 (use the 'mod' function to get remainders: '14 `mod` 12 == 31 | 2). -} 32 | 33 | newtype ClockHour = MkClockHour Int 34 | 35 | instance Eq ClockHour where 36 | x == y = undefined 37 | 38 | {- You should have: 39 | 40 | > (MkClockHour 2) == (MkClockHour 2) 41 | True 42 | 43 | > (MkClockHour 2) == (MkClockHour 14) 44 | True 45 | 46 | > (MkClockHour 2) == (MkClockHour 13) 47 | False 48 | 49 | > (MkClockHour 1) == (MkClockHour 2) 50 | False 51 | -} 52 | 53 | 54 | 55 | {- 3. Define Semigroup and Monoid instances for the following data type 56 | for rough counting: -} 57 | 58 | data RoughCount 59 | = Zero 60 | | One 61 | | Many 62 | deriving (Eq, Show) 63 | 64 | {- So that: 65 | 66 | - 'Zero' combined with 'x' gives 'x' 67 | - 'One' combined with 'One' is Many, and 68 | - 'Many' combined with anything is 'Many'. 69 | 70 | What is the 'mempty' that does nothing? -} 71 | 72 | instance Semigroup RoughCount where 73 | x <> y = undefined 74 | 75 | instance Monoid RoughCount where 76 | mempty = undefined 77 | 78 | 79 | 80 | {- 4. Define Semigroup and Monoid instances for the 'Tree a' data type, 81 | under the assumption that the type 'a' of data stored in the 82 | tree is a Semigroup. -} 83 | 84 | data Tree a 85 | = Leaf 86 | | Node (Tree a) a (Tree a) 87 | deriving Show 88 | 89 | {- The semigroup operation '<>' should merge trees. The rules of 90 | combination are as follows: 91 | 92 | - A leaf combined with any tree 't' is just 't'. 93 | 94 | - Combining a 'Node l1 x1 r1' and a 'Node l2 x2 r2' results in a 95 | 'Node' with: 96 | 97 | - Left sub-tree from combining 'l1' and 'l2' 98 | - Data from combining 'x1' and 'x2' 99 | - Right sub-tree from combining 'r1' and 'r2' 100 | 101 | The notation 'Semigroup a =>' tells Haskell that we are assuming 102 | that the type 'a' is an instance of Semigroup, just as it does in 103 | function types. -} 104 | 105 | instance Semigroup a => Semigroup (Tree a) where 106 | x <> y = undefined 107 | 108 | {- What is the 'Tree' that combines to no effect by the above rules? -} 109 | 110 | instance Semigroup a => Monoid (Tree a) where 111 | mempty = undefined 112 | 113 | 114 | 115 | {- 5. Define Semigroup and Monoid instances for the following datatype. -} 116 | 117 | newtype Fun a = MkFun (a -> a) 118 | 119 | unFun :: Fun a -> (a -> a) 120 | unFun (MkFun f) = f 121 | 122 | instance Semigroup (Fun a) where 123 | MkFun f <> MkFun g = undefined 124 | 125 | instance Monoid (Fun a) where 126 | mempty = undefined 127 | 128 | {- HINT: Think about composition from Week 03. There are /two/ different 129 | right answers for the Semigroup part. 130 | 131 | To make it a Monoid, What is the function that has no effect when 132 | composed with another? 133 | 134 | You should have: 135 | 136 | unFun (MkFun reverse <> MkFun reverse) [1,2,3] == [1,2,3] 137 | 138 | unFun (MkFun reverse <> MkFun id) [1,2,3] == [3,2,1] 139 | 140 | unFun (MkFun (+1) <> MkFun (+2)) 0 == 3 141 | -} 142 | 143 | 144 | 145 | {- 6. Define Semigroup and Monoid instances for the following datatype. -} 146 | 147 | newtype MaybeFun a = MkMaybeFun (a -> Maybe a) 148 | 149 | unMaybeFun :: MaybeFun a -> a -> Maybe a 150 | unMaybeFun (MkMaybeFun f) = f 151 | 152 | instance Semigroup (MaybeFun a) where 153 | MkMaybeFun f <> MkMaybeFun g = undefined 154 | 155 | instance Monoid (MaybeFun a) where 156 | mempty = undefined 157 | 158 | {- HINT: For this one, you'll need to define your own composition of 159 | functions that may fail, using a 'case'. 160 | 161 | You should have: 162 | 163 | unMaybeFun (MkMaybeFun (\_ -> Nothing) <> MkMaybeFun (\x -> Just x)) 1 == Nothing 164 | 165 | unMaybeFun (MkMaybeFun (\x -> Just x) <> MkMaybeFun (\x -> Just x)) 1 == Just 1 166 | -} 167 | 168 | 169 | 170 | 171 | 172 | {- 7. The 'OneTwoOrThree' type can be used to represent when we have 173 | either one, two, or three things: -} 174 | 175 | data OneTwoOrThree a 176 | = One_ a 177 | | Two a a 178 | | Three a a a 179 | deriving Show 180 | 181 | {- (a) Define a Functor instance for the OneTwoOrThree type: -} 182 | 183 | instance Functor OneTwoOrThree where 184 | fmap = undefined 185 | 186 | {- You should have: 187 | 188 | fmap (+1) (Three 1 2 3) == Three 2 3 4 189 | -} 190 | 191 | {- (b) Define a Foldable instance for the OneTwoOrThree type. We will 192 | use the standard library Foldable, which requires that we 193 | define 'foldMap' as well. We use the definition in terms of 194 | 'fmap' and 'fold' from Part 5.5 of the notes: 195 | -} 196 | 197 | instance Foldable OneTwoOrThree where 198 | foldMap f = fold . fmap f 199 | 200 | fold = undefined 201 | 202 | {- The following ought to work: 203 | 204 | fold (Three [1,2] [3,4] [5,6]) == [1,2,3,4,5,6] 205 | -} 206 | 207 | 208 | {- 8. Define a function of the type: 209 | 210 | toList :: (Functor c, Foldable c) => c a -> [a] 211 | 212 | which shows that with 'Foldable' you can always define a 213 | 'toList' function. -} 214 | 215 | toList :: (Functor c, Foldable c) => c a -> [a] 216 | toList = undefined 217 | 218 | {- If you only have a 'toList' function for a container can you always 219 | define 'fold'? -} 220 | 221 | 222 | {- 9. Use the 'RoughCount' monoid above to do a rough count of the 223 | number of 'True's in a container full of 'Bool's: -} 224 | 225 | roughlyHowTrue :: Foldable c => c Bool -> RoughCount 226 | roughlyHowTrue = undefined 227 | 228 | {- HINT: use 'foldMap' with a function that converts each 'Bool' to a 229 | 'RoughCount' that counts how 'True' it is. 230 | 231 | You should have: 232 | 233 | roughlyHowTrue [False, False, False] == Zero 234 | roughlyHowTrue [True, False, False] == One 235 | roughlyHowTrue [False, True, False] == One 236 | roughlyHowTrue [True, True, False] == Many 237 | roughlyHowTrue [False, True, True] == Many 238 | -} 239 | 240 | 241 | {- 10. Contrary to the notes, the standard library does not define 242 | Semigroup or Monoid instances for numeric types like 'Int' and 243 | 'Double'. Instead, the Data.Monoid module (imported above) 244 | defines two newtypes: 245 | 246 | newtype Product a = Product a 247 | 248 | newtype Sum a = Sum a 249 | 250 | with functions 'getProduct :: Product a -> a' and 251 | 'getSum :: Sum a -> a' that extract the values. 252 | 253 | When 'Num a' is true (i.e. 'a' is a numeric type), 'Product a' 254 | is a monoid that multiples and 'Sum a' is a monoid that adds. 255 | 256 | Use these functions with 'foldMap' to define generic 'sumAll' 257 | and 'productAll' functions for any foldable container 'c' and 258 | any kind of numeric type 'a': 259 | -} 260 | 261 | sumAll :: (Foldable c, Num a) => c a -> a 262 | sumAll = undefined 263 | 264 | productAll :: (Foldable c, Num a) => c a -> a 265 | productAll = undefined 266 | 267 | {- HINT: the trick is to think in three stages: 268 | 1. Every 'a' in the container needs to be converted to a 'Sum a' (or 'Product a'). 269 | 2. The 'fold' then sums them, or multiplies them. 270 | 3. We end up with a 'Product a' or 'Sum a', use the appropriate function to get back the 'a' 271 | -} 272 | 273 | 274 | {- 11. Use the 'Sum Int' monoid with foldMap to write a generic 'size' 275 | function, similar to the one in the notes. -} 276 | 277 | sizeGeneric :: Foldable c => c a -> Int 278 | sizeGeneric = undefined 279 | 280 | 281 | {- 12. The standard library module contains definitions to tell Haskell 282 | that the type of pairs forms a Monoid if the two constituent 283 | types do: 284 | 285 | instance (Monoid a, Monoid b) => Monoid (a,b) where 286 | ... 287 | 288 | 289 | Use this to write a generic 'average' function that combines 290 | the 'sumAll' and 'sizeGeneric' functions into one that does a 291 | *single* pass of the container. 292 | -} 293 | 294 | average :: Foldable c => c Double -> Double 295 | average c = total / fromInteger count 296 | where (Sum total, Sum count) = undefined -- fill in the 'undefined' 297 | -------------------------------------------------------------------------------- /lecture-notes/Week03Solutions.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -fwarn-incomplete-patterns #-} 2 | module Week03Solutions where 3 | 4 | import Data.Char 5 | 6 | {------------------------------------------------------------------------------} 7 | {- TUTORIAL QUESTIONS -} 8 | {------------------------------------------------------------------------------} 9 | 10 | {- 1. Lambda notation. 11 | 12 | Rewrite the following functions using the '\x -> e' notation (the 13 | "lambda" notation), so that they are written as 'double = 14 | ', and so on. -} 15 | 16 | mulBy2 :: Int -> Int 17 | mulBy2 = \x -> 2*x 18 | 19 | mul :: Int -> Int -> Int 20 | mul = \x y -> x * y 21 | 22 | invert :: Bool -> Bool 23 | invert = -- \x -> if x then False else True 24 | -- not 25 | \x -> case x of 26 | True -> False 27 | False -> True 28 | {- HINT: use a 'case', or an 'if'. -} 29 | 30 | 31 | {- 2. Partial Application 32 | 33 | The function 'mul' defined above has the type 'Int -> Int -> 34 | Int'. (a) What is the type of the Haskell expression: 35 | 36 | mul 10 37 | 38 | ANSWER: mul 10 has type 'Int -> Int' 39 | 40 | (b) what is 'mul 10'? How can you use it to multiply a number? 41 | 42 | ANSWER: 'mul 10' is a function that multiplies its argument bt 43 | 10. You can use to do this multiplication by applying it to a 44 | value. So 'mul 10 20' gives the answer 200. 45 | -} 46 | 47 | 48 | {- 3. Partial Application 49 | 50 | Write the 'mulBy2' function above using 'mul'. Can you make your 51 | function as short as possible? -} 52 | 53 | double_v2 :: Int -> Int 54 | double_v2 = mul 2 55 | 56 | {- The longer version is: 57 | 58 | double_v2 x = mul 2 x 59 | 60 | but every time you have a function definition that looks like this: 61 | 62 | fname x y z = z 63 | 64 | it can be shortened to: 65 | 66 | fname x y = 67 | -} 68 | 69 | {- 4. Using 'map'. 70 | 71 | The function 'toUpper' takes a 'Char' and turns lower case 72 | characters into upper cases one. All other characters it returns 73 | unmodified. For example: 74 | 75 | > toUpper 'a' 76 | 'A' 77 | > toUpper 'A' 78 | 'A' 79 | 80 | Strings are lists of characters. 'map' is a function that applies a 81 | function to every character in a list and returns a new list. 82 | 83 | Write the function 'shout' that uppercases a string, so that: 84 | 85 | > shout "hello" 86 | "HELLO" 87 | -} 88 | 89 | shout :: String -> String -- remember that String = [Char] 90 | shout = map toUpper 91 | 92 | 93 | {- Longer version: 94 | 95 | shout xs = map toUpper xs 96 | 97 | -} 98 | 99 | {- 5. Using 'map' with another function. 100 | 101 | The function 'concat' concatenates a lists of lists to make one 102 | list: 103 | 104 | > concat [[1,2],[3,4],[5,6]] 105 | [1,2,3,4,5,6] 106 | 107 | Using 'map', 'concat', and either a helper function or a function 108 | written using '\', write a function 'dupAll' that duplicates every 109 | element in a list. For example: 110 | 111 | > dupAll [1,2,3] 112 | [1,1,2,2,3,3] 113 | > dupAll "my precious" 114 | "mmyy pprreecciioouuss" 115 | 116 | HINT: try writing a helper function that turns single data values 117 | into two element lists. -} 118 | 119 | dupAll :: [a] -> [a] 120 | dupAll xs = concat (map (\x -> [x,x]) xs) 121 | 122 | 123 | {- A shorter version is this: 124 | 125 | dupAll = concat . map (\x -> [x,x]) 126 | 127 | which uses the composition operator '.' 128 | -} 129 | 130 | 131 | -- [1,2,3] 132 | -- [[1,1],[2,2],[3,3]] 133 | -- [1,1,2,2,3,3] 134 | 135 | {- Compare this to the recursive version: 136 | 137 | dupAll [] = [] 138 | dupAll (x:xs) = x : x : dupAll xs 139 | 140 | The difference between this and the definition using 'map' is that 141 | it mixes the concerns of 'duplicate an element' and 'do this to 142 | every element'. The version using 'map' explicitly makes clear that 143 | something is happening to every element of the list. 144 | 145 | In a small example like this, it is not immediately clear which 146 | version is easier, but when the amount of things we want to do to 147 | every element gets larger, map can often be clearer to show intent. -} 148 | 149 | 150 | 151 | {- 6. Using 'filter' 152 | 153 | (a) Use 'filter' to return a list consisting of only the 'E's in 154 | a 'String'. 155 | 156 | (b) Use 'onlyEs' and 'length' to count the number of 'E's in a string. 157 | 158 | (c) Write a single function that takes a character 'c' and a string 159 | 's' and counts the number of 'c's in 's'. -} 160 | 161 | onlyEs :: String -> String 162 | onlyEs = filter (\x -> x == 'E') 163 | 164 | numberOfEs :: String -> Int 165 | numberOfEs xs = length (onlyEs xs) 166 | 167 | {- A shorter version is: 168 | 169 | numberOfEs = length . onlyEs 170 | -} 171 | 172 | numberOf :: Char -> String -> Int 173 | numberOf c = length . filter (\x -> x == c) 174 | 175 | 176 | {- 7. Rewriting 'filter' 177 | 178 | (a) Write a function that does the same thing as filter, using 179 | 'map' and 'concat'. 180 | 181 | (b) Write a function that does a 'map' and a 'filter' at the same 182 | time, again using 'map' and 'concat'. 183 | -} 184 | 185 | {- This is idea of the solution below. If the predicate is "\x -> x == 'E'", then we map every 'E' to ['E'] and everything else to []. Then we concatenate all the lists. 186 | 187 | ['E', 'I','E', 'I','O'] 188 | ==> [['E'],[], ['E'], [], [] ] 189 | ==> ['E', 'E' ] 190 | -} 191 | 192 | filter_v2 :: (a -> Bool) -> [a] -> [a] 193 | filter_v2 p = concat . map (\x -> if p x then [x] else []) 194 | 195 | filterMap :: (a -> Maybe b) -> [a] -> [b] 196 | filterMap p = concat . map (\x -> case p x of 197 | Nothing -> [] 198 | Just y -> [y]) 199 | 200 | 201 | {- 8. Composition 202 | 203 | Write a function '>>>' that composes two functions: takes two 204 | functions 'f' and 'g', and returns a function that first runs 'f' 205 | on its argument, and then runs 'g' on the result. 206 | 207 | HINT: this is similar to the function 'compose'. -} 208 | 209 | (>>>) :: (a -> b) -> (b -> c) -> a -> c 210 | (>>>) f g x = g (f x) 211 | 212 | -- NOTE: the functions 'f' and 'g' appear the other way round in 213 | -- the function body. 214 | 215 | {- Try rewriting the 'numberOfEs' function from above using this one. -} 216 | 217 | numberOfEs_v2 = filter (\x -> x == 'E') >>> length 218 | 219 | {- 9. Backwards application 220 | 221 | Write a function of the following type that takes a value 'x' and a 222 | function 'f' and applies 'f' to 'x'. Note that this functions takes 223 | its arguments in reverse order to normal function application! -} 224 | 225 | (|>) :: a -> (a -> b) -> b 226 | (|>) x f = f x 227 | 228 | 229 | {- This function can be used between its arguments like so: 230 | 231 | "HELLO" |> map toLower 232 | 233 | and it is useful for chaining calls left-to-right instead of 234 | right-to-left as is usual in Haskell: 235 | 236 | "EIEIO" |> onlyEs |> length 237 | -} 238 | 239 | {- 10. Flipping 240 | 241 | Write a function that takes a two argument function as an input, 242 | and returns a function that does the same thing, but takes its 243 | arguments in reverse order: -} 244 | 245 | flip :: (a -> b -> c) -> b -> a -> c 246 | flip f a b = f b a 247 | 248 | 249 | {- 11. Evaluating Formulas 250 | 251 | Here is a datatype describing formulas in propositional logic, as 252 | in CS208 last year. Atomic formulas are represented as 'String's. -} 253 | 254 | data Formula 255 | = Atom String 256 | | And Formula Formula 257 | | Or Formula Formula 258 | | Not Formula 259 | deriving Show 260 | 261 | {- (a) Write a function that evaluates a 'Formula' to a 'Bool'ean value, 262 | assuming that all the atomic formulas are given the value 263 | 'True'. Note that the following Haskell functions do the basic 264 | operations on 'Bool'eans: 265 | 266 | (&&) :: Bool -> Bool -> Bool -- 'AND' 267 | (||) :: Bool -> Bool -> Bool -- 'OR' 268 | not :: Bool -> Bool -- 'NOT' 269 | -} 270 | 271 | eval_v1 :: Formula -> Bool 272 | eval_v1 (Atom a) = True 273 | eval_v1 (And p q) = eval_v1 p && eval_v1 q 274 | eval_v1 (Or p q) = eval_v1 p || eval_v1 q 275 | eval_v1 (Not p) = not (eval_v1 p) 276 | 277 | 278 | 279 | 280 | {- (b) Now write a new version of 'eval_v1' that, instead of evaluating 281 | every 'Atom a' to 'True', takes a function that gives a 'Bool' 282 | for each atomic proposition: -} 283 | 284 | eval :: (String -> Bool) -> Formula -> Bool 285 | eval v (Atom a) = v a 286 | eval v (And p q) = eval v p && eval v q 287 | eval v (Or p q) = eval v p || eval v q 288 | eval v (Not p) = not (eval v p) 289 | 290 | {- For example: 291 | 292 | eval (\s -> s == "A") (Or (Atom "A") (Atom "B")) == True 293 | eval (\s -> s == "A") (And (Atom "A") (Atom "B")) == False 294 | -} 295 | 296 | 297 | {- 12. Substituting Formulas 298 | 299 | Write a function that, given a function 's' that turns 'String's 300 | into 'Formula's (a "substitution"), replaces all the atomic 301 | formulas in a Formula with whatever 'f' tells it to: -} 302 | 303 | subst :: (String -> Formula) -> Formula -> Formula 304 | subst v (Atom a) = v a 305 | subst v (And p q) = subst v p `And` subst v q 306 | subst v (Or p q) = subst v p `Or` subst v q 307 | subst v (Not p) = Not (subst v p) 308 | 309 | {- For example: 310 | 311 | subst (\s -> if s == "A" then Not (Atom "A") else Atom s) (And (Atom "A") (Atom "B")) == And (Not (Atom "A")) (Atom "B") 312 | -} 313 | 314 | {- 13. Evaluating with failure 315 | 316 | The 'eval' function in 8(b) assumed that every atom could be 317 | assigned a value. But what if it can't? Write a function of the 318 | following type that takes as input a function that may or may not 319 | give a 'Bool' for each atom, and correspondingly, may or may not 320 | give a 'Bool' for the whole formula. -} 321 | 322 | evalMaybe :: (String -> Maybe Bool) -> Formula -> Maybe Bool 323 | evalMaybe v (Atom a) = v a 324 | evalMaybe v (And p q) = 325 | case evalMaybe v p of 326 | Nothing -> Nothing 327 | Just x -> 328 | case evalMaybe v q of 329 | Nothing -> Nothing 330 | Just y -> 331 | Just (x && y) 332 | evalMaybe v (Or p q) = 333 | case evalMaybe v p of 334 | Nothing -> Nothing 335 | Just x -> 336 | case evalMaybe v q of 337 | Nothing -> Nothing 338 | Just y -> 339 | Just (x || y) 340 | evalMaybe v (Not p) = 341 | case evalMaybe v p of 342 | Nothing -> Nothing 343 | Just x -> 344 | Just (not x) 345 | 346 | {- This is pretty complex and noisy looking, because it makes all the 347 | error handling explicit. On the other hand, it is easy to trace 348 | what will happen in all of the possible cases, including those that 349 | happen when there are errors. We will see ways of making it look 350 | nicer in Weeks 6 & 7. 351 | 352 | One thing to think about is why the 'Atom a' case is this: 353 | 354 | evalMaybe v (Atom a) = v a 355 | 356 | and not: 357 | 358 | evalMaybe v (Atom a) = 359 | case v a of 360 | Nothing -> Nothing 361 | Just x -> Just x 362 | 363 | the answer is that anything like: 364 | 365 | case of 366 | Nothing -> Nothing 367 | Just x -> Just x 368 | 369 | is always equal to '' -- the 'case' is returning 370 | 'Nothing' when the value is 'Nothing' and 'Just x' when it is 'Just 371 | x', so in the end it does nothing to the value returned by 372 | '' and can be removed. -} 373 | -------------------------------------------------------------------------------- /lecture-notes/Week04Solutions.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ParallelListComp #-} 2 | {-# OPTIONS_GHC -fwarn-incomplete-patterns #-} 3 | module Week04Solutions where 4 | 5 | import Prelude hiding (foldr, foldl, Maybe (..), Left, Right, filter, zip, map, concat) 6 | import Data.List.Split (splitOn) 7 | import Data.List hiding (foldr, foldl, filter, map, concat) 8 | import Week04 9 | 10 | {------------------------------------------------------------------------------} 11 | {- TUTORIAL QUESTIONS -} 12 | {------------------------------------------------------------------------------} 13 | 14 | {- 1. The following recursive function returns the list it is given as 15 | input: -} 16 | 17 | listIdentity :: [a] -> [a] 18 | listIdentity [] = [] 19 | listIdentity (x:xs) = x : listIdentity xs 20 | 21 | {- Write this function as a 'foldr': -} 22 | 23 | listIdentity' :: [a] -> [a] 24 | listIdentity' = foldr (\x r -> x : r) -- step case, combines the head and the tail using ':' 25 | [] -- base case, the empty list [] 26 | 27 | {- See how the base case is the same as the first clause in the original 28 | definition of 'listIdentity'. The step case is the same as the 29 | second clause, except that the recursive call 'listIdentity xs' has 30 | been replaced by 'r'. 31 | 32 | We can also shorten this to: 33 | 34 | listIdentity' = foldr (:) [] 35 | 36 | because '(:)' is the same thing as '(\x r -> x : r)': any infix 37 | operation, like ':' can be written as a function that takes two 38 | arguments by putting it in brackets. 39 | 40 | Let's see how this works by writing out the steps on a short list: 41 | 42 | foldr (\x r -> x:r) [] [1,2] 43 | = (\x r -> x:r) 1 (foldr (\x r -> x:r) [] [2]) 44 | = (\x r -> x:r) 1 ((\x r -> x:r) 2 (foldr (\x r -> x:r) [] [])) 45 | = (\x r -> x:r) 1 ((\x r -> x:r) 2 []) 46 | = (\x r -> x:r) 1 (2:[]) 47 | = 1:2:[] 48 | = [1,2] 49 | -} 50 | 51 | {- 2. The following recursive function does a map and a filter at the 52 | same time. If the function argument sends an element to 53 | 'Nothing' it is discarded, and if it sends it to 'Just b' then 54 | 'b' is placed in the output list. -} 55 | 56 | mapFilter :: (a -> Maybe b) -> [a] -> [b] 57 | mapFilter f [] = [] 58 | mapFilter f (x:xs) = case f x of 59 | Nothing -> mapFilter f xs 60 | Just b -> b : mapFilter f xs 61 | 62 | {- Write this function as a 'foldr': -} 63 | 64 | mapFilter' :: (a -> Maybe b) -> [a] -> [b] 65 | mapFilter' f = foldr (\x r -> case f x of Nothing -> r -- \___ step case 66 | Just b -> b : r) -- / 67 | [] -- base case 68 | 69 | {- The base case is the same as for 'listIdentity'' above. 70 | 71 | In the step case, we have to decide whether or not to add the new 72 | element to the list. We 'case' on the result of 'f x'. If it is 73 | 'Nothing', we return 'r' (which is representing the recursive call 74 | 'mapFilter f xs'). If it is 'Just b', we put 'b' on the front of 75 | 'r' (compare the 'listIdentity' function above). -} 76 | 77 | 78 | {- 3. Above we saw that 'foldl' and 'foldr' in general give different 79 | answers. However, it is possible to define 'foldl' just by using 80 | 'foldr'. 81 | 82 | First try to define a function that is the same as 'foldl', 83 | using 'foldr', 'reverse' and a '\' function: -} 84 | 85 | {- The key thing to notice is that the difference between 'foldl' and 86 | 'foldr' is that 'foldl' goes left-to-right and 'foldr' goes right 87 | to left. So it makes sense to reverse the input list. The function 88 | argument 'f' then takes its arguments in the wrong order, so we 89 | flip them using a little '\' function. -} 90 | 91 | foldlFromFoldrAndReverse :: (b -> a -> b) -> b -> [a] -> b 92 | foldlFromFoldrAndReverse f x xs = foldr (\a b -> f b a) x (reverse xs) 93 | 94 | {- We could have also used the 'flip' function from last week's 95 | questions, which is provided by the standard library: -} 96 | 97 | foldlFromFoldrAndReverse_v2 :: (b -> a -> b) -> b -> [a] -> b 98 | foldlFromFoldrAndReverse_v2 f x xs = foldr (flip f) x (reverse xs) 99 | 100 | {- Much harder: define 'foldl' just using 'foldr' and a '\' function: -} 101 | 102 | {- 103 | foldl :: (b -> a -> b) -> b -> [a] -> b 104 | foldl f a [] = a 105 | foldl f a (x:xs) = foldl f (f a x) xs 106 | -} 107 | 108 | -- This is quite a bit more complex than the other solution using 109 | -- 'reverse'. The key idea is to construct a "transformer" function 110 | -- with 'foldr' that acts like 'foldl' would. Try writing out some 111 | -- steps of this function with some example 'f's to see how it works. 112 | 113 | foldlFromFoldr :: (b -> a -> b) -> b -> [a] -> b 114 | foldlFromFoldr f a xs = foldr (\a g b -> g (f b a)) id xs a 115 | 116 | {- Remember from Week03 that 'id' is '\x -> x': the function that just 117 | returns its argument. -} 118 | 119 | {- Understanding 'foldlFromFoldr' may take a bit of work. The key point 120 | is that we use 'foldr' to build a /function/ from the input list 121 | 'xs' that will compute the left fold from any given initial value. 122 | 123 | In more detail, the 'foldr' is used to build a function that takes 124 | an accumulator argument, similar to the 'fastReverse' function in 125 | Week01: 126 | 127 | - The 'id' is the base case: it takes the accumulator and returns 128 | it (compare the first clause of 'foldl', which returns 'a'). 129 | 130 | - The '\a g b -> g (f b a)' is the step case: 131 | 132 | - 'a' is the value from the input list 133 | - 'g' is the result of processing the rest of the list, which a 134 | /function/ that is expecting an accumulator. 135 | - 'b' is the accumulator so far. 136 | 137 | So this function combines the value 'a' and the accumulator 'b' 138 | using 'f', and passes that to 'g'. 139 | 140 | So it is doing a 'fastReverse' and a 'foldr' at the same time (with 141 | the flipped arguments to 'f'), so can be seen as an optimised 142 | version of the first solution. 143 | 144 | It may be helpful to understand the /types/ involved. We are 145 | writing a function with this type (the type of 'foldl'): 146 | 147 | (b -> a -> b) -> b -> [a] -> b 148 | 149 | and 'foldr' has this generic type: 150 | 151 | (a -> b -> b) -> b -> [a] -> b 152 | 153 | but we are *using* 'foldr' with this type: 154 | 155 | foldr :: (a -> (b -> b) -> (b -> b)) -> -- 'step case' 156 | (b -> b) -> -- 'base case' 157 | [a] -> -- 'input list' 158 | b -> -- 'initial accumulator' 159 | b -- result 160 | 161 | Note that the 'step case' takes a function and returns a function: 162 | we are building a /function/ by recursion. 163 | 164 | Don't worry if you don't get this at the first few attempts. It 165 | takes some time to rewrite your mind to see functions as something 166 | that can be built incrementally by other functions! Looking at the 167 | types is usually a good way to not get lost. -} 168 | 169 | 170 | 171 | {- 4. The following is a datatype of Natural Numbers (whole numbers 172 | greater than or equal to zero), represented in unary. A natural 173 | number 'n' is represented as 'n' applications of 'Succ' to 174 | 'Zero'. So '2' is 'Succ (Succ Zero)'. Using the same recipe we 175 | used above for 'Tree's and 'Maybe's, work out the type and 176 | implementation of a 'fold' function for 'Nat's. -} 177 | 178 | data Nat 179 | = Zero -- a bit like [] 180 | | Succ Nat -- a bit like x : xs, but without the 'x' 181 | deriving Show 182 | 183 | foldNat :: (b -> b) -> b -> Nat -> b 184 | foldNat succ zero Zero = zero 185 | foldNat succ zero (Succ n) = succ (foldNat succ zero n) 186 | 187 | {- HINT: think about proofs by induction. A proof by induction has a 188 | base case and a step case. -} 189 | 190 | {- Here we have 'zero' for the base case, 'succ' for the step case. 191 | 192 | As an example, we can define 'add' for 'Nat' in terms of 'foldNat', 193 | which has a similar structure to 'append' for lists: -} 194 | 195 | add :: Nat -> Nat -> Nat 196 | add x y = foldNat Succ y x 197 | 198 | {- 5. Write a list comprehension to generate all the cubes (x*x*x) of 199 | the numbers 1 to 10: -} 200 | 201 | cubes :: [Int] 202 | cubes = [ x*x*x | x <- [1..10] ] 203 | 204 | 205 | {- 6. The replicate function copies a single value a fixed number of 206 | times: 207 | 208 | > replicate 5 'x' 209 | "xxxxx" 210 | 211 | Write a version of replicate using a list comprehension: -} 212 | 213 | replicate' :: Int -> a -> [a] 214 | replicate' n a = [ a | _ <- [1..n]] 215 | 216 | {- 7. One-pass Average. 217 | 218 | It is possible to use 'foldr' to 219 | implement many other interesting functions on lists. For example 220 | 'sum' and 'len': -} 221 | 222 | sumDoubles :: [Double] -> Double 223 | sumDoubles = foldr (\x sum -> x + sum) 0 224 | 225 | lenList :: [a] -> Integer 226 | lenList = foldr (\_ l -> l + 1) 0 227 | 228 | {- Putting these together, we can implement 'avg' to compute the average 229 | (mean) of a list of numbers: -} 230 | 231 | avg :: [Double] -> Double 232 | avg xs = sumDoubles xs / fromInteger (lenList xs) 233 | 234 | {- Neat as this function is, it is not as efficient as it could be. It 235 | traverses the input list twice: once to compute the sum, and then 236 | again to compute the length. It would be better if we had a single 237 | pass that computed the sum and length simultaneously and returned a 238 | pair. 239 | 240 | Implement such a function, using foldr: -} 241 | 242 | sumAndLen :: [Double] -> (Double, Integer) 243 | sumAndLen = foldr (\x (sum, len) -> (x + sum, len + 1)) (0,0) 244 | 245 | -- NOTE: The solution combines the functions used in 'sumDoubles' and 246 | -- 'lenList' by making it take a pair '(sum,len)' as well as the list 247 | -- element 'x'. It then adds 'x' to the 'sum' part and '1' to the 248 | -- 'len' part. 249 | 250 | {- Once you have implemented your 'sumAndLen' function, this alternative 251 | average function will work: -} 252 | 253 | avg' :: [Double] -> Double 254 | avg' xs = total / fromInteger length 255 | where (total, length) = sumAndLen xs 256 | 257 | {- 8. mapTree from foldTree 258 | 259 | Here is the 'Tree' datatype that is imported from the Week04 module: 260 | 261 | data Tree a 262 | = Leaf 263 | | Node (Tree a) a (Tree a) 264 | deriving Show 265 | 266 | As we saw in the lecture notes, it is possible to write a generic 267 | recursor pattern for trees, similar to 'foldr', copied here for reference: 268 | 269 | foldTree :: b -> (b -> a -> b -> b) -> Tree a -> b 270 | foldTree l n Leaf = l 271 | foldTree l n (Node lt x rt) = n (foldTree l n lt) x (foldTree l n rt) 272 | 273 | Your job is to implement 'mapTree' (from Week03) in terms of 274 | 'foldTree': -} 275 | 276 | mapTree :: (a -> b) -> Tree a -> Tree b 277 | mapTree f = foldTree Leaf -- Leaf case: 'Leaf's become 'Leaf's 278 | (\l x r -> Node l (f x) r) -- Node case: 'Node's become 'Node's, but with the data changed 279 | 280 | {- Here is the explicitly recursive version of 'mapTree', for 281 | reference: -} 282 | 283 | mapTree0 :: (a -> b) -> Tree a -> Tree b 284 | mapTree0 f Leaf = Leaf 285 | mapTree0 f (Node lt x rt) = Node (mapTree0 f lt) (f x) (mapTree0 f rt) 286 | 287 | 288 | {- 9. Finally, use 'foldTree' to flatten a tree to list in left-to-right 289 | order: -} 290 | 291 | flatten :: Tree a -> [a] 292 | flatten = foldTree [] -- Leaf case: has no elements, so is the empty list 293 | (\l x r -> l ++ [x] ++ r) -- Node case: append the left, middle, and right together 294 | -------------------------------------------------------------------------------- /lecture-notes/Week05Solutions.hs: -------------------------------------------------------------------------------- 1 | module Week05Solutions where 2 | 3 | import Data.Foldable 4 | import Data.Monoid 5 | import Data.Bits (FiniteBits(countLeadingZeros)) 6 | 7 | {------------------------------------------------------------------------------} 8 | {- TUTORIAL QUESTIONS -} 9 | {------------------------------------------------------------------------------} 10 | 11 | {- 1. Define a 'Show' instance for the following datatype that prints 12 | out the data in a JSON-like format. For example, 13 | 14 | show (MkHost "www.cis.strath.ac.uk" 80) == "{\"name\":\"www.cis.strath.ac.uk\", \"port\": 80}" 15 | 16 | The backslashes before the '"'s in the string are "escape 17 | characters". They are there so that Haskell knows not to end the 18 | string at this point. 19 | -} 20 | 21 | data Host = MkHost String Int 22 | 23 | instance Show Host where 24 | show (MkHost name port) = 25 | "{\"name\":\"" ++ name ++ "\", \"port\": " ++ show port ++ "}" 26 | 27 | -- NOTE: we include 'name' directly, because we are adding our own 28 | -- quote marks. But for the port number, we have to use 'show' to 29 | -- convert the number to a string. 30 | 31 | {- 2. Define an 'Eq' instance for the following datatype that makes two 32 | numbers equal if they have the same remainder after division by 33 | 12 (use the 'mod' function to get remainders: '14 `mod` 12 == 34 | 2). -} 35 | 36 | newtype ClockHour = MkClockHour Int 37 | 38 | instance Eq ClockHour where 39 | MkClockHour x == MkClockHour y = x `mod` 12 == y `mod` 12 40 | 41 | -- NOTE: to be more clear, we could have put some parentheses in to 42 | -- show how things get grouped together: 43 | -- 44 | -- ((MkClockHour x) == (MkClockHour y)) = ((x `mod` 12) == (y `mod` 12)) 45 | 46 | {- You should have: 47 | 48 | > (MkClockHour 2) == (MkClockHour 2) 49 | True 50 | 51 | > (MkClockHour 2) == (MkClockHour 14) 52 | True 53 | 54 | > (MkClockHour 2) == (MkClockHour 13) 55 | False 56 | 57 | > (MkClockHour 1) == (MkClockHour 2) 58 | False 59 | -} 60 | 61 | 62 | 63 | {- 3. Define Semigroup and Monoid instances for the following data type 64 | for rough counting: -} 65 | 66 | data RoughCount 67 | = Zero 68 | | One 69 | | Many 70 | deriving (Eq, Show) 71 | 72 | {- So that: 73 | 74 | - 'Zero' combined with 'x' gives 'x' 75 | - 'One' combined with 'One' is Many, and 76 | - 'Many' combined with anything is 'Many'. 77 | 78 | What is the 'mempty' that does nothing? -} 79 | 80 | instance Semigroup RoughCount where 81 | Zero <> x = x -- Zero and 'x' is 'x' 82 | x <> Zero = x 83 | One <> One = Many -- One and One is Many 84 | Many <> _ = Many -- Adding Many to anything... 85 | _ <> Many = Many -- ... gives Many 86 | 87 | instance Monoid RoughCount where 88 | mempty = Zero 89 | 90 | 91 | 92 | {- 4. Define Semigroup and Monoid instances for the 'Tree a' data type, 93 | under the assumption that the type 'a' of data stored in the 94 | tree is a Semigroup. -} 95 | 96 | data Tree a 97 | = Leaf 98 | | Node (Tree a) a (Tree a) 99 | deriving Show 100 | 101 | {- The semigroup operation '<>' should merge trees. The rules of 102 | combination are as follows: 103 | 104 | - A leaf combined with any tree 't' is just 't'. 105 | 106 | - Combining a 'Node l1 x1 r1' and a 'Node l2 x2 r2' results in a 107 | 'Node' with: 108 | 109 | - Left sub-tree from combining 'l1' and 'l2' 110 | - Data from combining 'x1' and 'x2' 111 | - Right sub-tree from combining 'r1' and 'r2' 112 | 113 | The notation 'Semigroup a =>' tells Haskell that we are assuming 114 | that the type 'a' is an instance of Semigroup, just as it does in 115 | function types. -} 116 | 117 | instance Semigroup a => Semigroup (Tree a) where 118 | -- First point above: 119 | Leaf <> y = y 120 | x <> Leaf = x 121 | -- Second point: 122 | Node l1 x1 r1 <> Node l2 x2 r2 = Node (l1 <> l2) (x1 <> x2) (r1 <> r2) 123 | 124 | {- What is the 'Tree' that combines to no effect by the above rules? -} 125 | 126 | instance Semigroup a => Monoid (Tree a) where 127 | mempty = Leaf 128 | 129 | 130 | 131 | {- 5. Define Semigroup and Monoid instances for the following datatype. -} 132 | 133 | newtype Fun a = MkFun (a -> a) 134 | 135 | unFun :: Fun a -> (a -> a) 136 | unFun (MkFun f) = f 137 | 138 | instance Semigroup (Fun a) where 139 | MkFun f <> MkFun g = MkFun (f . g) 140 | 141 | -- NOTE: the answer is nothing more than function composition + the 142 | -- constructor. Note that we also get a Semigroup if we compose the 143 | -- other way round: 144 | -- 145 | -- MkFun f <> MkFun g = MkFun (g . f) 146 | -- 147 | -- This is possible because the source and target type in 'a -> a' are 148 | -- the same. 149 | 150 | instance Monoid (Fun a) where 151 | mempty = MkFun id 152 | 153 | {- HINT: Think about composition from Week 03. There are /two/ different 154 | right answers for the Semigroup part. 155 | 156 | To make it a Monoid, What is the function that has no effect when 157 | composed with another? 158 | 159 | You should have: 160 | 161 | unFun (MkFun reverse <> MkFun reverse) [1,2,3] == [1,2,3] 162 | 163 | unFun (MkFun reverse <> MkFun id) [1,2,3] == [3,2,1] 164 | 165 | unFun (MkFun (+1) <> MkFun (+2)) 0 == 3 166 | -} 167 | 168 | 169 | 170 | {- 6. Define Semigroup and Monoid instances for the following datatype. -} 171 | 172 | newtype MaybeFun a = MkMaybeFun (a -> Maybe a) 173 | 174 | unMaybeFun :: MaybeFun a -> a -> Maybe a 175 | unMaybeFun (MkMaybeFun f) = f 176 | 177 | instance Semigroup (MaybeFun a) where 178 | MkMaybeFun f <> MkMaybeFun g = MkMaybeFun (composeMaybe f g) 179 | 180 | -- NOTE: to compose a function that returns a Maybe, we have to do a 181 | -- case on whether or not it succeeds: 182 | 183 | composeMaybe :: (a -> Maybe a) -> (a -> Maybe a) -> (a -> Maybe a) 184 | composeMaybe f g x = case f x of 185 | Nothing -> Nothing 186 | Just y -> g y 187 | 188 | instance Monoid (MaybeFun a) where 189 | mempty = MkMaybeFun (\x -> Just x) 190 | 191 | -- NOTE: the "do nothing" element here is '\x -> Just x'. We can see 192 | -- why by seeing how it computes with 'composeMaybe': 193 | -- 194 | -- Combining with (\x -> Just x) on the left and 'g' on the right 195 | -- gives: 196 | -- 197 | -- composeMaybe (\x -> Just x) g x 198 | -- == case (\x -> Just x) x of Nothing -> Nothing; Just y -> g y 199 | -- == case Just x of Nothing -> Nothing; Just y -> g y 200 | -- == g x 201 | -- 202 | -- and the other way round: 203 | -- 204 | -- composeMaybe f (\x -> Just x) x 205 | -- == case f x of Nothing -> Nothing; Just y -> (\x -> Just x) y 206 | -- == case f x of Nothing -> Nothing; Just y -> Just y 207 | -- == f x 208 | 209 | {- HINT: For this one, you'll need to define your own composition of 210 | functions that may fail, using a 'case'. 211 | 212 | You should have: 213 | 214 | unMaybeFun (MkMaybeFun (\_ -> Nothing) <> MkMaybeFun (\x -> Just x)) 1 == Nothing 215 | 216 | unMaybeFun (MkMaybeFun (\x -> Just x) <> MkMaybeFun (\x -> Just x)) 1 == Just 1 217 | -} 218 | 219 | 220 | 221 | 222 | 223 | {- 7. The 'OneTwoOrThree' type can be used to represent when we have 224 | either one, two, or three things: -} 225 | 226 | data OneTwoOrThree a 227 | = One_ a 228 | | Two a a 229 | | Three a a a 230 | deriving Show 231 | 232 | {- (a) Define a Functor instance for the OneTwoOrThree type: -} 233 | 234 | instance Functor OneTwoOrThree where 235 | fmap f (One_ x) = One_ (f x) 236 | fmap f (Two x y) = Two (f x) (f y) 237 | fmap f (Three x y z) = Three (f x) (f y) (f z) 238 | 239 | {- You should have: 240 | 241 | fmap (+1) (Three 1 2 3) == Three 2 3 4 242 | -} 243 | 244 | {- (b) Define a Foldable instance for the OneTwoOrThree type. We will 245 | use the standard library Foldable, which requires that we 246 | define 'foldMap' as well. We use the definition in terms of 247 | 'fmap' and 'fold' from Part 5.5 of the notes: 248 | -} 249 | 250 | instance Foldable OneTwoOrThree where 251 | foldMap f = fold . fmap f 252 | 253 | fold (One_ x) = x 254 | fold (Two x y) = x <> y 255 | fold (Three x y z) = x <> y <> z 256 | 257 | {- The following ought to work: 258 | 259 | fold (Three [1,2] [3,4] [5,6]) == [1,2,3,4,5,6] 260 | -} 261 | 262 | 263 | {- 8. Define a function of the type: 264 | 265 | toList :: (Functor c, Foldable c) => c a -> [a] 266 | 267 | which shows that with 'Foldable' you can always define a 268 | 'toList' function. -} 269 | 270 | toList :: (Functor c, Foldable c) => c a -> [a] 271 | toList = fold . fmap (\x -> [x]) 272 | 273 | {- If you only have a 'toList' function for a container can you always 274 | define 'fold'? -} 275 | 276 | -- NOTE: we can do it like this: 277 | -- 278 | -- fold = foldr (<>) mempty . toList 279 | -- 280 | -- 'toList' first converts to flat list of the elements, and then we 281 | -- use 'foldr' to combine them all into one. 282 | 283 | 284 | {- 9. Use the 'RoughCount' monoid above to do a rough count of the 285 | number of 'True's in a container full of 'Bool's: -} 286 | 287 | roughlyHowTrue :: Foldable c => c Bool -> RoughCount 288 | roughlyHowTrue = foldMap (\x -> if x then One else Zero) 289 | 290 | -- NOTE: Using 'foldMap', we just need to convert each boolean to 291 | -- 'One' or 'Zero' as appropriate. 292 | 293 | {- HINT: use 'foldMap' with a function that converts each 'Bool' to a 294 | 'RoughCount' that counts how 'True' it is. 295 | 296 | You should have: 297 | 298 | roughlyHowTrue [False, False, False] == Zero 299 | roughlyHowTrue [True, False, False] == One 300 | roughlyHowTrue [False, True, False] == One 301 | roughlyHowTrue [True, True, False] == Many 302 | roughlyHowTrue [False, True, True] == Many 303 | -} 304 | 305 | 306 | {- 10. Contrary to the notes, the standard library does not define 307 | Semigroup or Monoid instances for numeric types like 'Int' and 308 | 'Double'. Instead, the Data.Monoid module (imported above) 309 | defines two newtypes: 310 | 311 | newtype Product a = Product a 312 | 313 | newtype Sum a = Sum a 314 | 315 | with functions 'getProduct :: Product a -> a' and 316 | 'getSum :: Sum a -> a' that extract the values. 317 | 318 | When 'Num a' is true (i.e. 'a' is a numeric type), 'Product a' 319 | is a monoid that multiples and 'Sum a' is a monoid that adds. 320 | 321 | Use these functions with 'foldMap' to define generic 'sumAll' 322 | and 'productAll' functions for any foldable container 'c' and 323 | any kind of numeric type 'a': 324 | -} 325 | 326 | sumAll :: (Foldable c, Num a) => c a -> a 327 | sumAll = getSum . foldMap Sum 328 | 329 | productAll :: (Foldable c, Num a) => c a -> a 330 | productAll = getProduct . foldMap Product 331 | 332 | -- NOTE: 'Sum' is equivalent to (\x -> Sum x), treating the 333 | -- constructor as a function. Similar for 'Product' 334 | 335 | {- HINT: the trick is to think in three stages: 336 | 1. Every 'a' in the container needs to be converted to a 'Sum a' (or 'Product a'). 337 | 2. The 'fold' then sums them, or multiplies them. 338 | 3. We end up with a 'Product a' or 'Sum a', use the appropriate function to get back the 'a' 339 | -} 340 | 341 | 342 | {- 11. Use the 'Sum Int' monoid with foldMap to write a generic 'size' 343 | function, similar to the one in the notes. -} 344 | 345 | sizeGeneric :: Foldable c => c a -> Int 346 | sizeGeneric = getSum . foldMap (\_ -> Sum 1) 347 | 348 | -- NOTE: instead of adding up the values in the container, we convert 349 | -- all of them to '1' and then add them up. 350 | 351 | 352 | {- 12. The standard library module contains definitions to tell Haskell 353 | that the type of pairs forms a Monoid if the two constituent 354 | types do: 355 | 356 | instance (Monoid a, Monoid b) => Monoid (a,b) where 357 | ... 358 | 359 | 360 | Use this to write a generic 'average' function that combines 361 | the 'sumAll' and 'sizeGeneric' functions into one that does a 362 | *single* pass of the container. 363 | -} 364 | 365 | average :: Foldable c => c Double -> Double 366 | average c = total / fromInteger count 367 | where (Sum total, Sum count) = foldMap (\x -> (Sum x, Sum 1)) c 368 | -------------------------------------------------------------------------------- /lecture-notes/Week02Solutions.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -fwarn-incomplete-patterns #-} 2 | module Week02Solutions where 3 | 4 | import Week02 5 | 6 | {------------------------------------------------------------------------------} 7 | {- TUTORIAL QUESTIONS -} 8 | {------------------------------------------------------------------------------} 9 | 10 | {- In the questions below, replace 'undefined' with your answers. Use 11 | GHCi to test them.-} 12 | 13 | {- 1. Write a function that counts the number of occurrences of an 14 | element in list: -} 15 | 16 | -- Three alternate solutions: 17 | 18 | popCount1 :: Eq a => a -> [a] -> Int 19 | popCount1 y [] = 0 20 | popCount1 y (x:xs) = (if x == y then 1 else 0) + popCount1 y xs 21 | 22 | popCount2 :: Eq a => a -> [a] -> Int 23 | popCount2 y [] = 0 24 | popCount2 y (x:xs) 25 | | x == y = 1 + popCount2 y xs 26 | | otherwise = popCount2 y xs 27 | 28 | popCount3 :: Eq a => a -> [a] -> Int 29 | popCount3 y [] = 0 30 | popCount3 y (x:xs) = if x == y then 1 + popCount3 y xs else popCount3 y xs 31 | 32 | {- (popCount is short for "population count"). Examples: 33 | 34 | popCount 2 [1,2,5,2,7,2,9] == 3 35 | popCount 9 [1,2,5,2,7,2,9] == 1 36 | popCount 0 [1,2,5,2,7,2,9] == 0 37 | -} 38 | 39 | 40 | {- 2. Write a version of 'insert' that only inserts into a sorted list 41 | if the element is not already there. Examples: 42 | 43 | insertNoDup 2 [1,3,4] == [1,2,3,4] 44 | insertNoDup 2 [1,2,3,4] == [1,2,3,4] 45 | -} 46 | 47 | -- Four possible solutions: 48 | 49 | -- Using a guard, similar to the 'insert' above, but with an 50 | -- additional check. 51 | insertNoDup :: Ord a => a -> [a] -> [a] 52 | insertNoDup x [] = [x] 53 | insertNoDup x (y:ys) 54 | | x < y = x : y : ys 55 | | x == y = y : ys 56 | | otherwise = y : insertNoDup x ys 57 | 58 | -- Doing a pre-check and then inserting if it isn't there: does two 59 | -- scans of the list, instead of one. 60 | insertNoDup2 :: Ord a => a -> [a] -> [a] 61 | insertNoDup2 y xs = if popCount1 y xs == 0 then insert y xs else xs 62 | 63 | -- Doing a pre-check and then sorting the new element in. Takes n^2 64 | -- time in the worst case. 65 | insertNoDup3 :: Ord a => a -> [a] -> [a] 66 | insertNoDup3 a [] = [a] 67 | insertNoDup3 a (x:xs) = if popCount1 a (x:xs) <= 0 then isort (a:x:xs) else (x:xs) 68 | 69 | -- Variant of the first solution, but using a case expression instead 70 | -- of guards. 71 | insertNoDup4 :: Ord a => a -> [a] -> [a] 72 | insertNoDup4 y [] = [y] 73 | insertNoDup4 y (x:xs) = case compare y x of 74 | LT -> y:x:xs 75 | EQ -> x:xs 76 | GT -> x:insertNoDup4 y xs 77 | 78 | {- 3. Write a version of 'remove' that removes all copies of an element 79 | from a sorted list, not just the first one. Examples: 80 | 81 | removeAll 2 [1,2,2,3] == [1,3] 82 | removeAll 2 [1,3] == [1,3] 83 | -} 84 | 85 | -- Similar to editing 'insert' to get 'insertNoDup', can edit 'remove' 86 | -- to get 'removeAll'. 87 | removeAll :: Ord a => a -> [a] -> [a] 88 | removeAll y [] = [] 89 | removeAll y (x:xs) 90 | | x == y = removeAll y xs 91 | | x < y = x:removeAll y xs 92 | | otherwise = x:xs 93 | 94 | 95 | {- 4. Rewrite 'treeFind' and 'treeInsert' to use 'compare' and 'case' 96 | expressions. -} 97 | 98 | treeFind2 :: Ord k => k -> KV k v -> Maybe v 99 | treeFind2 k Leaf = Nothing 100 | treeFind2 k (Node l (k',v') r) = 101 | case compare k k' of 102 | LT -> treeFind2 k l 103 | EQ -> Just v' 104 | GT -> treeFind2 k r 105 | 106 | 107 | -- An example tree: Node (Node (Node Leaf ("A",0) Leaf) ("a",1) Leaf) ("b",2) (Node Leaf ("c",3) Leaf) 108 | {- ("b",2) 109 | / \ 110 | ("a",1) ("c",3) 111 | ("A",0) Leaf Leaf Leaf 112 | Leaf Leaf 113 | -} 114 | 115 | treeInsert2 :: Ord k => k -> v -> KV k v -> KV k v 116 | treeInsert2 k v Leaf = Node Leaf (k,v) Leaf 117 | treeInsert2 k v (Node l (k',v') r) = 118 | case compare k k' of 119 | EQ -> Node l (k,v) r 120 | LT -> Node (treeInsert2 k v l) (k',v') r 121 | GT -> Node l (k',v') (treeInsert2 k v r) 122 | 123 | {- 5. MergeSort is another sorting algorithm that works in the following 124 | way: 125 | 126 | - If the list to be sorted is zero length, then it is already 127 | sorted. 128 | 129 | - If the list to be sorted has one element, then it is already 130 | sorted. 131 | 132 | - Otherwise, split the list into two, one with the even elements 133 | and one with the odd elements. Sort the two lists by calling 134 | 'mergeSort' recursively. Then merge the two lists together 135 | maintaining the ordering. 136 | 137 | Write this function in three parts: -} 138 | 139 | {- 'split' splits the input into two lists: one with the odd numbered 140 | elements and one with the even numbered elements. HINT: you can 141 | pattern match on multiple elements at the head of a list with 142 | 'x1:x2:xs', and you can use the '(odds,evens) = ...' syntax in a 143 | 'where' clause. -} 144 | 145 | -- Three possible solutions: 146 | 147 | -- Pattern matching on two elements at a time 148 | split :: [a] -> ([a], [a]) 149 | split [] = ([],[]) 150 | split (x:[]) = ([x],[]) 151 | split (x1:x2:xs) = (x1:odds, x2:evens) 152 | where (odds, evens) = split xs 153 | 154 | -- Pattern matching on one element at a time, switching the meaning of 155 | -- odd and even elements: 156 | split2 :: [a] -> ([a],[a]) 157 | split2 [] = ([], []) 158 | split2 (x:xs) = (x:evens, odds) 159 | where (odds, evens) = split2 xs 160 | 161 | -- A solution using list comprehensions (See Week 04) 162 | split3 :: [a] -> ([a], [a]) 163 | split3 xs = (odds,evens) 164 | where odds = [x | (x,y) <- zip xs [1..], odd y] 165 | evens = [x | (x,y) <- zip xs [1..], even y] 166 | 167 | {- 'merge' merges two sorted lists into one sorted list. Examples: 168 | 169 | merge [1,3,5] [2,4,6] = [1,2,3,4,5,6] 170 | merge [1,3,5] [7,9,11] = [1,3,5,7,9,11] 171 | -} 172 | 173 | -- merging works as follows: 174 | merge :: Ord a => [a] -> [a] -> [a] 175 | merge [] ys = ys -- if there is only one list to merge... 176 | merge xs [] = xs -- ... then just return it 177 | merge (x:xs) (y:ys) -- otherwise, take one element from both 178 | | x <= y = x : merge xs (y:ys) -- if 'x' is lower, output it and merge 'xs' and 'y:ys' 179 | | otherwise = y : merge (x:xs) ys -- if 'y' is lower, do the symmetric thing. 180 | 181 | 182 | {- 'mergeSort' uses 'split' and 'merge' to implement the merge sort 183 | algorithm described above. -} 184 | 185 | mergeSort :: Ord a => [a] -> [a] 186 | mergeSort [] = [] -- empty list is sorted 187 | mergeSort [x] = [x] -- one element list is sorted 188 | mergeSort xs = merge (mergeSort xs1) (mergeSort xs2) 189 | where (xs1,xs2) = split xs 190 | -- otherwise, split, sort recursively and then merge. 191 | 192 | 193 | {- 6. Write another version of 'makeChange' that returns all the 194 | possible ways of making change as a list: -} 195 | 196 | -- The following solution is a roundabout way of getting to the 197 | -- solution to demonstrate the similarity between the 'Maybe' version 198 | -- and the list version. You're not expected to have come up with this 199 | -- chain of thought. 200 | 201 | -- here is the original 'makeChange', renamed to 'makeChange1': 202 | makeChange1 :: [Coin] -> [Coin] -> Int -> Maybe [Coin] 203 | makeChange1 coins used 0 = Just used 204 | makeChange1 [] used _ = Nothing 205 | makeChange1 (coin:coins) used amount 206 | | amount >= coin = 207 | case makeChange1 coins (coin:used) (amount - coin) of 208 | Just coins -> Just coins 209 | Nothing -> makeChange1 coins used amount 210 | | otherwise = 211 | makeChange1 coins used amount 212 | 213 | -- We can think of 'Maybe' as a kind of container that can contain 214 | -- zero or one elements. Similarly, we can think of lists as 215 | -- containers that contain zero, one, two, three, ... elements. 216 | 217 | -- Thinking like this, we can think: what does it mean to "append" two 218 | -- 'Maybe's? One answer is: 219 | 220 | addMaybe :: Maybe a -> Maybe a -> Maybe a 221 | addMaybe Nothing y = y 222 | addMaybe (Just x) _ = Just x 223 | 224 | -- Which is like list append (Week 01), except that if the first 225 | -- 'Maybe' contains something, then we ignore the second one. 226 | -- 227 | -- With this function we can rewrite 'makeChange' to have the same 228 | -- behaviour: 229 | 230 | makeChange2 :: [Coin] -> [Coin] -> Int -> Maybe [Coin] 231 | makeChange2 coins used 0 = Just used 232 | makeChange2 [] used _ = Nothing 233 | makeChange2 (coin:coins) used amount 234 | | amount >= coin = 235 | makeChange2 coins (coin:used) (amount - coin) 236 | `addMaybe` 237 | makeChange2 coins used amount 238 | | otherwise = 239 | makeChange2 coins used amount 240 | 241 | -- Now we can convert to lists instead of 'Maybe': 242 | -- 243 | -- 1. 'Just used' becomes '[used]' (a container with one element) 244 | -- 2. 'Nothing' becomes '[]' (a container with no elements) 245 | -- 3. 'addMaybe' becomes '++' (different way of adding containers) 246 | 247 | --So we get: 248 | 249 | makeChangeAll :: [Coin] -> [Coin] -> Int -> [[Coin]] 250 | makeChangeAll coins used 0 = [used] 251 | makeChangeAll [] used _ = [] 252 | makeChangeAll (coin:coins) used amount 253 | | amount >= coin = 254 | makeChangeAll coins (coin:used) (amount - coin) 255 | ++ 256 | makeChangeAll coins used amount 257 | | otherwise = 258 | makeChangeAll coins used amount 259 | 260 | -- Now we can ask for all ways to make change: 261 | -- 262 | -- > makeChangeAll [50,20,20,10,2,2,1] [] 54 263 | -- [[2,2,50],[2,2,10,20,20]] 264 | 265 | {- HINT: you don't need a case expression, just a way of appending two 266 | lists of possibilities. -} 267 | 268 | 269 | {- 7. This question involves converting between two datatypes. A 'Row' 270 | is a list of strings, such as you might find in a database: -} 271 | 272 | -- | A row is a list of strings, one for each field. For example: 273 | -- 274 | -- > ["Mount Snowden", "Wales"] 275 | type Row = [String] 276 | 277 | {- Note that the names of the fields, which might be 'Mountain' and 278 | 'Country' here, are implicit in this representation. 279 | 280 | The second type is a record, which is a list of pairs of field 281 | names with their data: -} 282 | 283 | -- | A record is a list of fieldname / value pairs. For example: 284 | -- 285 | -- > [("Mountain", "Mont Blanc"), ("Country", "France")] 286 | type Record = [(String,String)] 287 | 288 | {- Implement the following functions on rows and records: -} 289 | 290 | -- | Look up a field in a record, returning @Nothing@ if the field is 291 | -- not in the record. For example, 292 | -- > lookupField "a" [("a","1"),("b","2")] 293 | -- returns @Just "1"@, but 294 | -- > lookupField "c" [("a","1"),("b","3")] 295 | -- returns @Nothing@. 296 | lookupField :: String -> Record -> Maybe String 297 | lookupField fieldname [] = Nothing 298 | lookupField fieldname ((nm, val):record) = 299 | if nm == fieldname then Just val else lookupField fieldname record 300 | 301 | -- | Given a header listing field names, like: 302 | -- 303 | -- > ["Mountain", "Country"] 304 | -- 305 | -- and a row like: 306 | -- 307 | -- > ["Ben Nevis", "Scotland"] 308 | -- 309 | -- turn it into a record like: 310 | -- 311 | -- > [("Mountain", "Ben Nevis"), ("Country", "Scotland")] 312 | -- 313 | -- If the number of field names in the header does not match the 314 | -- number of fields in the row, an @Nothing@ should be returned. 315 | rowToRecord :: [String] -> Row -> Maybe Record 316 | rowToRecord [] [] = Just [] 317 | rowToRecord (hdr:hdrs) (x:xs) = 318 | case rowToRecord hdrs xs of 319 | Nothing -> Nothing 320 | Just record -> Just ((hdr,x):record) 321 | rowToRecord _ _ = Nothing 322 | 323 | -- | Given a header listing field names, and a list of rows, converts 324 | -- each row into a record. See 'rowToRecord' for how individual rows 325 | -- are converted to records. 326 | rowsToRecords :: [String] -> [Row] -> Maybe [Record] 327 | rowsToRecords header [] = Just [] 328 | rowsToRecords header (row:rows) = 329 | case rowsToRecords header rows of 330 | Nothing -> Nothing 331 | Just records -> 332 | case rowToRecord header row of 333 | Nothing -> Nothing 334 | Just record -> 335 | Just (record:records) 336 | 337 | -- | Given a header listing field names, like: 338 | -- 339 | -- > ["Mountain", "Country"] 340 | -- 341 | -- and a record like: 342 | -- 343 | -- > [("Mountain", "Ben Nevis"), ("Country", "Scotland")] 344 | -- 345 | -- turn it into a row like: 346 | -- 347 | -- > ["Ben Nevis", "Scotland"] 348 | -- 349 | -- It does not matter what order the fields in the record are in, so the 350 | -- record: 351 | -- 352 | -- > [("Country", "Scotland"), ("Mountain", "Ben Nevis")] 353 | -- 354 | -- should result in the same row. 355 | -- 356 | -- This function returns an @Nothing@ if any of the field names listed in 357 | -- the header are not in the record. 358 | recordToRow :: [String] -> Record -> Maybe Row 359 | recordToRow [] record = Just [] 360 | recordToRow (f:fs) record = 361 | case lookupField f record of 362 | Nothing -> Nothing 363 | Just val -> 364 | case recordToRow fs record of 365 | Nothing -> Nothing 366 | Just row -> 367 | Just (val:row) 368 | 369 | -- | Given a header listing field names, and a list of records, 370 | -- converts each record into a row. See 'recordToRow' for how 371 | -- individual records are converted to rows. 372 | recordsToRows :: [String] -> [Record] -> Maybe [Row] 373 | recordsToRows header [] = Just [] 374 | recordsToRows header (record:records) = 375 | case recordToRow header record of 376 | Nothing -> Nothing 377 | Just row -> 378 | case recordsToRows header records of 379 | Nothing -> Nothing 380 | Just rows -> 381 | Just (row:rows) 382 | -------------------------------------------------------------------------------- /lecture-notes/Week07.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE InstanceSigs #-} 2 | {-# LANGUAGE RebindableSyntax #-} 3 | {-# OPTIONS_GHC -fwarn-incomplete-patterns #-} 4 | module Week07 where 5 | 6 | import Prelude hiding ( Monad (..) 7 | , Applicative (..) 8 | , mapM 9 | , mapM_ 10 | , (<$>)) 11 | import Data.Char (isDigit, digitToInt) 12 | 13 | {- This is needed due to the RebindableSyntax extension. I'm using this 14 | extension so the 'do' notation in this file uses my redefined 15 | 'Monad' type class, not the standard library one. RebindableSyntax 16 | lets the user redefine what 'do', and 'if' mean. I've given 'if' 17 | the standard meaning here: -} 18 | ifThenElse True x y = x 19 | ifThenElse False x y = y 20 | (>>) x y = x >>= \_ -> y 21 | 22 | 23 | {- WEEK 7 : MONADS 24 | 25 | Last week we saw three examples of how to simulate side effects 26 | with "pure" code in Haskell: 27 | 28 | 1. simulating exceptions using the 'Maybe' type, 29 | 30 | 2. simulating mutable state by explicit state passing, and 31 | 32 | 3. simulating printing by collecting outputs. 33 | 34 | This week, we look at the common pattern in all these examples, and 35 | give it a name: 'Monad'. -} 36 | 37 | 38 | {- Part 7.1 : DEFINING MONADS and THE MAYBE MONAD 39 | 40 | In each of the three cases, we saw that there is common 41 | structure. Each one had a "do nothing" operation: 42 | 43 | returnOk :: a -> Maybe a 44 | returnState :: a -> State a 45 | returnPrinting :: a -> Printing a 46 | 47 | and a "do this, then do that" operation: 48 | 49 | ifOK :: Maybe a -> (a -> Maybe b) -> Maybe b 50 | andThen :: State a -> (a -> State b) -> State b 51 | andThenWithPrinting :: Printing a -> (a -> Printing b) -> Printing b 52 | 53 | The Week 06 tutorial questions asked you to write this function for 54 | 'Process'es, with yet again a similar type. 55 | 56 | sequ :: Process a -> (a -> Process b) -> Process b 57 | 58 | If there was only one example, it wouldn't be interesting. Two or 59 | three is maybe a coincidence. But four examples is calling out for 60 | this common pattern to be given a name. 61 | 62 | For historical reasons coming from the mathematical field of 63 | Category Theory, that name is "Monad", which is not the best name 64 | that could have been used in a programming context. However, it is 65 | the name that has stuck, so we use it. 66 | 67 | ASIDE: One of the inventors of Haskell, and the main author of 68 | the GHC compiler, Simon Peyton Jones, has suggested that the 69 | name 'Monad' has been quite harmful, and that they should have 70 | been called 'Warm Fuzzy Thing' instead. This link is to slides 71 | from a talk entitled "Wearing the hair shirt: a retrospective on 72 | Haskell" from 2003, where he looks back on the first 15 years of 73 | Haskell as it was then: 74 | 75 | https://www.microsoft.com/en-us/research/wp-content/uploads/2016/07/HaskellRetrospective.ppt 76 | 77 | 78 | 79 | Along with the name 'Monad', we have two standard names for the "do 80 | nothing" and "do this, then that" operations. The first is called 81 | 'return'. The second is called '>>=', which is pronounced 'bind' 82 | because we think of it "binding" the result of the first operation 83 | in the continuation. 84 | 85 | In Haskell, we can use a type class to give a name to all type 86 | constructors 'm' that have a 'returnOk' and a '(>>=)': -} 87 | 88 | class Monad m where 89 | return :: a -> m a 90 | (>>=) :: m a -> (a -> m b) -> m b 91 | 92 | {- This type class definition answers the question "what is a 'Monad'?" 93 | A Monad is any type constructor 'm' (e.g., 'Maybe', 'State', 94 | 'Printing', 'Process') that has two operations: 'return' and 95 | '(>>=)' with the types shown. Of course, this doesn't answer the 96 | question of why this is a useful definition. Hopefully, the 97 | examples we have seen so far will have gone some way to justifying 98 | the cost of introducing a new type class in terms of having to 99 | understand new things. 100 | 101 | Let's now see how to make the examples from last week into 102 | instances of the 'Monad' type class. Each of these will also have 103 | several extra operations beyond the 'return' and '>>=' that are 104 | peculiar to that instance. 105 | 106 | We'll also see that Haskell treats the 'Monad' type class a little 107 | bit specially, in that Haskell has special syntax for writing 108 | programs that use '>>=' ("bind"), called "'do' notation". -} 109 | 110 | 111 | {- In Week 06, we saw definitions of 'returnOk' and 'ifOK' for 112 | 'Maybe'. Let's now put them in an instance for the 'Monad' type 113 | class, declaring 'Maybe' to be a 'Monad' by implementing the two 114 | required functions: -} 115 | 116 | instance Monad Maybe where 117 | return :: a -> Maybe a 118 | return x = Just x 119 | 120 | (>>=) :: Maybe a -> (a -> Maybe b) -> Maybe b 121 | op >>= f = case op of 122 | Nothing -> Nothing 123 | Just x -> f x 124 | 125 | {- The 'Maybe' monad also has a special operation called 'failure', for 126 | representing an exception being thrown: -} 127 | 128 | failure :: Maybe a 129 | failure = Nothing 130 | 131 | {- And a 'catch' operation that simulates an exception being caught: -} 132 | 133 | catch :: Maybe a -> Maybe a -> Maybe a 134 | catch op handler = 135 | case op of 136 | Nothing -> handler 137 | Just x -> Just x 138 | 139 | 140 | {- Part 7.2 : 'do' NOTATION 141 | 142 | Last week, we saw that using functions like 'ifOK', 'andThen' and 143 | 'andThenWithPrinting', we can significantly tidy up functions that 144 | perform side effects. However, they are still a little bit messy 145 | due to the repeated use of the helper functions. Now that we've 146 | defined the 'Monad' type class, we do at least have the option of 147 | using the same function name ('>>=') every time. However, Haskell 148 | also provides a handy notation for making functions that use Monads 149 | look nicer. 150 | 151 | Let's look at the 'lookupAll' function from Week 06 and see how 152 | 'do' makes things a little simpler. Here's the 'Tree' datatype: -} 153 | 154 | data Tree a 155 | = Leaf 156 | | Node (Tree a) a (Tree a) 157 | deriving Show 158 | 159 | {- And the 'search' function that may fail to find a 'k'ey: -} 160 | 161 | search :: Eq k => k -> [(k,v)] -> Maybe v 162 | search k [] = failure 163 | search k ((k',v'):kvs) = if k == k' then return v' else search k kvs 164 | 165 | lookupAll :: Eq k => [(k,v)] -> Tree k -> Maybe (Tree v) 166 | lookupAll kvs Leaf = 167 | return Leaf 168 | lookupAll kvs (Node l k r) = 169 | lookupAll kvs l >>= \l' -> 170 | search k kvs >>= \v -> 171 | lookupAll kvs r >>= \r' -> 172 | return (Node l' v r') 173 | 174 | {- This definition is still a bit messy, since it involves a lot of 175 | repetition of '>>=' and uses of '\' (lambda) to write 176 | functions. Also, the names for the results of operations is to the 177 | right of the operation that produces them, which is a bit weird. We 178 | can use Haskell's "'do' notation" to make this look nicer: -} 179 | 180 | lookupAll_v2 :: Eq k => [(k,v)] -> Tree k -> Maybe (Tree v) 181 | lookupAll_v2 kvs Leaf = 182 | return Leaf 183 | lookupAll_v2 kvs (Node l k r) = 184 | do l' <- lookupAll_v2 kvs l 185 | v <- search k kvs 186 | r' <- lookupAll_v2 kvs r 187 | return (Node l' v r') 188 | 189 | {- Which hides all the uses of '>>=' and the lambdas, and starts to look 190 | like a normal sequence of instructions to be executed one after the 191 | other. 192 | 193 | How does 'do' notation work? The Haskell compiler translates each 194 | line as follows: 195 | 196 | do x <- e1 becomes e1 >>= (\x -> e2) 197 | e2 198 | 199 | and 200 | 201 | do e1 becomes e1 >> e2 202 | e2 203 | 204 | (where '(>>) op1 op2 = op >>= \_ -> op2') 205 | 206 | and 207 | 208 | do e becomes e 209 | 210 | This kind of translation is sometimes called "syntactic sugar": it 211 | adds nothing to the language that we couldn't do before, but 212 | sweetens the experience a bit. 213 | 214 | "Syntactic sugar causes cancer of the semicolon" 215 | -- Alan J. Perlis 216 | Epigrams in Programming 217 | http://www.cs.yale.edu/homes/perlis-alan/quotes.html 218 | 219 | -} 220 | 221 | 222 | {- Part 7.3 : STATE MONAD 223 | 224 | In Week 06, we defined a type synonym for "state mutating operation 225 | that returns a value of type 'a'": 226 | 227 | type State a = Int -> (Int, a) 228 | 229 | Haskell's type class feature doesn't allow us to define type 230 | synonyms as instances of type classes, so we need to define a 231 | 'newtype' that does the same thing, but this time with a 232 | constructor: -} 233 | 234 | newtype State a = MkState (Int -> (Int, a)) 235 | 236 | {- The 'runState' function now pattern matches on the 'MkState' 237 | constructor and returns the underlying state mutation function: -} 238 | 239 | runState :: State a -> Int -> (Int, a) 240 | runState (MkState t) = t 241 | 242 | {- Now we can define the 'Monad' instance for 'State', using the same 243 | definitions as in Week 06, except with extra uses of 'MkState' and 244 | 'runState' to move between the 'State' type and the underlying 245 | representation: -} 246 | 247 | instance Monad State where 248 | return :: a -> State a 249 | return x = 250 | MkState (\s -> (s, x)) 251 | 252 | (>>=) :: State a -> (a -> State b) -> State b 253 | op >>= f = 254 | MkState (\s -> 255 | let (s0, a) = runState op s 256 | (s1, b) = runState (f a) s0 257 | in (s1, b)) 258 | 259 | {- The 'get' and 'put' primitive state mutators are defined as before, 260 | again with an extra 'MkState': -} 261 | 262 | get :: State Int 263 | get = MkState (\s -> (s,s)) 264 | 265 | put :: Int -> State () 266 | put i = MkState (\_ -> (i,())) 267 | 268 | {- Because we have defined a 'Monad' instance for 'State', we 269 | automatically get to use 'do' notation. For example, here is the 270 | 'getAndIncrement' state mutation operation from Week 06, written in 271 | as a sequence of steps: -} 272 | 273 | getAndIncrement :: State Int 274 | getAndIncrement = 275 | do x <- get 276 | put (x+1) 277 | return x 278 | 279 | {- Now we can write 'numberTree' using 'do' notation, which makes the 280 | whole implementation easier to read: -} 281 | 282 | numberTree :: Tree a -> State (Tree (a, Int)) 283 | numberTree Leaf = 284 | return Leaf 285 | numberTree (Node l x r) = 286 | do l' <- numberTree l 287 | i <- getAndIncrement 288 | r' <- numberTree r 289 | return (Node l' (x, i) r') 290 | 291 | 292 | {- Part 7.4 PRINTING MONAD -} 293 | 294 | {- Just as we made 'State' an instance of 'Monad', we can do the same 295 | for 'Printing'. In the Week 06, we defined 'Printing' as a type 296 | synonym: 297 | 298 | type Printing a = ([String]), a) 299 | 300 | Again, due to the way that type classes work, we need to define a 301 | new datatype. Here, this datatype has one constructor which takes 302 | two arguments: the list of strings that have been printed, and the 303 | result value: -} 304 | 305 | data Printing a = MkPrinting [String] a 306 | deriving Show 307 | 308 | {- The definitions of 'return' and '>>=' are the same as in Week 06, 309 | except with the uses of 'MkPrinting' instead of the pair type '( , 310 | )': -} 311 | 312 | instance Monad Printing where 313 | return :: a -> Printing a 314 | return x = MkPrinting [] x 315 | 316 | (>>=) :: Printing a -> (a -> Printing b) -> Printing b 317 | op >>= f = 318 | let MkPrinting o1 a = op 319 | MkPrinting o2 b = f a 320 | in MkPrinting (o1 ++ o2) b 321 | 322 | {- The primitive operation for 'Printing' is 'printLine', as we wrote in 323 | Week 06: -} 324 | 325 | printLine :: String -> Printing () 326 | printLine s = MkPrinting [s] () 327 | 328 | {- Again, because 'Printing' is a 'Monad', we can use the 'do' notation 329 | with it. Here is an 'add' function that adds its arguments, but 330 | also emits a logging message as it does so. The type signature 331 | tells us that it may do some 'Printing': -} 332 | 333 | add :: Int -> Int -> Printing Int 334 | add x y = 335 | do printLine ("Adding " ++ show x ++ " and " ++ show y) 336 | return (x+y) 337 | 338 | {- We can also rewrite the 'printAndSum' function from Week 06: -} 339 | 340 | printAndSum :: Tree Int -> Printing Int 341 | printAndSum Leaf = 342 | return 0 343 | printAndSum (Node l x r) = 344 | do lsum <- printAndSum l 345 | printLine (show x) 346 | rsum <- printAndSum r 347 | return (lsum + x + rsum) 348 | 349 | 350 | {- Part 7.5 : FUNCTIONS FOR ALL MONADS 351 | 352 | We've already seen one benefit of declaring the 'Monad' type class: 353 | we can use 'do' notation to simplify programs that are best written 354 | as a sequence of steps. 355 | 356 | Another advantage that we'll come back to in the next few weeks is 357 | the ability to define Monads that don't have analogues in most 358 | languages. For instance, we can define a Monad of "multi-valued 359 | functions", which is useful for defining search functions, and a 360 | Monad of "parsers". 361 | 362 | A third advantage is the ability to write functions that work for 363 | all monads, not just 'Maybe', 'State', 'Printing', etc. This allows 364 | us to capture common patterns, such as mapping a function over a 365 | list, while doing some side effects. This function is called 366 | 'mapM': -} 367 | 368 | mapM :: Monad m => (a -> m b) -> [a] -> m [b] 369 | mapM f [] = return [] 370 | mapM f (x:xs) = 371 | do y <- f x 372 | ys <- mapM f xs 373 | return (y:ys) 374 | 375 | {- From the type signature, we can see that 'mapM' is similar to 'map': 376 | 377 | map :: (a -> b) -> [a] -> [b] 378 | 379 | except that the function argument has type 'a -> m b', and the 380 | final '[b]' has an 'm' before it. These extra 'm's indicate that 381 | the function passed to 'mapM' may perform some side effects for 382 | every 'a' in the input list, and that some side effects may be 383 | performed before generating the output list. 384 | 385 | An example usage of 'mapM' is the following. Let's say we have a 386 | list of characters, which we expect to be digits '0' .. '9', but 387 | we're not sure if they all are. We want to convert the list into a 388 | list of 'Int's corresponding to the digits, but raise an exception 389 | if we find a non-digit. 390 | 391 | We can use 'Maybe' to simulate raising an exception, and write this 392 | function as follows, using two functions from the 'Data.Char' 393 | module in the standard library: -} 394 | 395 | readDigits :: [Char] -> Maybe [Int] 396 | readDigits = mapM (\c -> if isDigit c then 397 | return (digitToInt c) 398 | else 399 | failure) 400 | 401 | {- Often we just want to perform some side effect for every element in 402 | the list, and we don't care about generating an output list. In 403 | that case, we can use a variant of 'mapM' that doesn't build an 404 | output list: -} 405 | 406 | mapM_ :: Monad m => (a -> m ()) -> [a] -> m () 407 | mapM_ f [] = return () 408 | mapM_ f (x:xs) = 409 | do f x 410 | mapM_ f xs 411 | 412 | {- The underscore at the end of the name is a convention for a variant 413 | of a function that returns '()' instead of another data structure. 414 | 415 | 'mapM_' enables us to write something like the 'for each' loops in 416 | languages that have pervasive side effects. For instance, to print 417 | out each element of a list using the 'Printing' monad, we use 418 | 'mapM_' to iterate over the list, instead of doing the recursion 419 | ourselves: -} 420 | 421 | printList :: Show a => [a] -> Printing () 422 | printList = mapM_ (\x -> printLine (show x)) 423 | 424 | {- To make this look a bit nicer, the standard library defines a version 425 | of 'mapM_' called 'for_' tha swaps the order of the arguments: -} 426 | 427 | for_ :: Monad m => [a] -> (a -> m ()) -> m () 428 | for_ xs f = mapM_ f xs 429 | 430 | {- Swapping the order of the arguments enables us to write things like: 431 | 432 | for_ (\x -> ) 433 | 434 | Like printing out the whole list: -} 435 | 436 | printList_v2 :: Show a => [a] -> Printing () 437 | printList_v2 xs = 438 | for_ xs (\x -> printLine (show x)) 439 | 440 | {- Or printing out the numbers from 1 to 10 (using the [1..10] 441 | notation): -} 442 | 443 | printNumbers :: Printing () 444 | printNumbers = 445 | for_ [1..10] (\i -> printLine (show i)) 446 | 447 | {- Using the 'State' monad, we can write functions that we previous 448 | wrote using recursion and immutable variables using loops and 449 | mutable variables. For example, getting the length of a list by 450 | starting a counter at 0, and then adding 1 to the counter for each 451 | element of the list: -} 452 | 453 | lengthImp :: [a] -> State Int 454 | lengthImp xs = 455 | do put 0 456 | for_ xs (\_ -> do 457 | len <- get 458 | put (len+1)) 459 | result <- get 460 | return result 461 | 462 | {- Or summing up a list by using the mutable state as the running total: -} 463 | 464 | sumImp :: [Int] -> State Int 465 | sumImp xs = 466 | do put 0 467 | for_ xs (\x -> do 468 | total <- get 469 | put (total + x)) 470 | result <- get 471 | return result 472 | --------------------------------------------------------------------------------