Haskell snippets
Posted on September 2, 2022
Tags: functional
- Biggest issue with haskell is the function types Hide the compositional behavior inside the function.
f::A->Bbut inside the function it may actually beA->F A . F A -> G A . G A -> G . G -> B
1 Basics
-- Enumeration types
data Bool = True | False
data Color = Red | Green | Blue
-- Record types that contain fields
data Vector2d = MakeVector Double Double
data Person = Person Int String
-- Parameterized types. Note the type parameter `a`
data PairOf a = TwoValues a a
-- Recursive types
data IntList = Empty | Node Int IntList
-- Complex types which combine many of these features
data Maybe a = Nothing | Just a
data Either a b = Left a | Right b
data List a = Nil | Cons a (List a) -- This is equivalent to the built-in [a] type
data Tree a = Leaf a | Node a (Tree a) (Tree a)
data MultiTree a = MultiTree a [MultiTree a] -- Note the list
--Guards behave like switch statements
ilog3 :: Integer -> Integer
ilog3 x
| (x < 3) = 1
| otherwise = 1 + ilog3 (div x 3)
eitherDiv :: Integer -> Integer -> Either String Integer
eitherDiv x 0 = Left ((show x) ++ "/0")
eitherDiv x y = Right (div x y)
--coproducts
addEithers :: Either String Int -> Either String Int -> Either String Int
addEithers (Right a) (Right b) = (Right (a+b))
addEithers (Right a) (Left b) = Left b
addEithers (Left a) _ = Left a
--let and where keyword
countdown :: Integer -> String
countdown x = let y = helpr x
in "Ready!" ++ y ++ "Liftoff!"
where
helpr 0 = " "
helpr n = " " ++show n ++ "..." ++ helpr (n-1)
--list comprehension
smallestDivisor :: Integer -> Integer
smallestDivisor n = head [x | x <- [2..n], mod n x == 0]
-- mapMaybe length Nothing ==> Nothing
-- mapMaybe length (Just "abc") ==> Just 3
mapMaybe :: (a -> b) -> Maybe a -> Maybe b
mapMaybe f Nothing = Nothing
mapMaybe f (Just x) = (Just (f x))
-- (f . g) x = f (g x).
--
-- Examples:
-- multiCompose [] "foo" ==> "foo"
-- multiCompose [] 1 ==> 1
-- multiCompose [(++"bar")] "foo" ==> "foobar"
-- multiCompose [reverse, tail, (++"bar")] "foo" ==> "raboo"
-- multiCompose [(3*), (2^), (+1)] 0 ==> 6
-- multiCompose [(+1), (2^), (3*)] 0 ==> 2
multiCompose :: [a -> a] -> a -> a
multiCompose fs x = foldr (.) id fs x
-- Tail recursive function similar to while loop in other languages
-- buildList 1 5 2 ==> [1,1,1,1,1,2]
-- buildList 7 0 3 ==> [3]
buildList :: Int -> Int -> Int -> [Int]
buildList x 0 z = [z]
buildList x n z = x:(buildList x (n-1) z)
-- myMaximum [] ==> 0
-- myMaximum [1,3,2] ==> 3
myMaximum :: [Int] -> Int
myMaximum [] = 0
myMaximum (x:xs) = foldr maxHelper x xs
maxHelper :: (Ord a) => a -> a -> a --(Ord a) is the class constraint allowing comparisons
maxHelper x y = max x y
-- given an Array, find the index of the largest element.
-- assume the Array isn't empty.
--
-- You may assume that the largest element is unique.
--
-- Use Data.Array.indices or Data.Array.assocs
maxIndex :: (Ix i, Ord a) => Array i a -> i
maxIndex g = (fst . head) [x | x <- assocs g, snd x == maximum g]
-- def fibonacci(n):
-- a = 0
-- b = 1
-- while n>1:
-- c = a+b
-- a = b
-- b = c
-- n = n-1
-- return b
fibonacci :: Integer -> Integer
fibonacci n = fibonacci' 0 1 n
fibonacci' :: Integer -> Integer -> Integer -> Integer
fibonacci' a b 1 = b
fibonacci' a b n = fibonacci' b (a+b) (n-1)2 Recursion
-- Some imports you'll need. Don't add other imports :)
import Data.List
------------------------------------------------------------------------------
-- Ex 1: compute binomial coefficients using recursion. Binomial
-- coefficients are defined by the following equations:
--
-- B(n,k) = B(n-1,k) + B(n-1,k-1)
-- B(n,0) = 1
-- B(0,k) = 0, when k>0
--
-- Hint! pattern matching is your friend.
binomial :: Integer -> Integer -> Integer
binomial n 0 = 1
binomial 0 k = 0
binomial n k = binomial (n-1) k + binomial (n-1) (k-1)
------------------------------------------------------------------------------
-- Ex 2: implement the odd factorial function. Odd factorial is like
-- factorial, but it only multiplies odd numbers.
--
-- Examples:
-- oddFactorial 7 ==> 7*5*3*1 ==> 105
-- oddFactorial 6 ==> 5*3*1 ==> 15
oddFactorial :: Integer -> Integer
oddFactorial 1 = 1
oddFactorial n
| mod n 2 == 0 = oddFactorial (n-1)
| mod n 2 /= 0 = n * oddFactorial (n-1)
------------------------------------------------------------------------------
-- Ex 3: implement the Euclidean Algorithm for finding the greatest
-- common divisor:
--
-- Given two numbers, a and b,
-- * if one is zero, return the other number
-- * if not, subtract the smaller number from the larger one
-- * replace the larger number with this new number
-- * repeat
--
-- For example,
-- myGcd 9 12 ==> 3
-- In this case, the algorithm proceeds like this
--
-- a b
--
-- 9 12
-- 9 (12-9)
-- 9 3
-- (9-3) 3
-- 6 3
-- (6-3) 3
-- 3 3
-- (3-3) 3
-- 0 3
--
-- Background reading:
-- * https://en.wikipedia.org/wiki/Euclidean_algorithm
myGcd :: Integer -> Integer -> Integer
myGcd 0 b = b
myGcd a 0 = a
myGcd a b
| (a >= b) = myGcd (a-b) b
| (a < b) = myGcd a (b-a)
------------------------------------------------------------------------------
-- Ex 4: Implement the function leftpad which adds space characters
-- to the start of the string until it is long enough.
--
-- Examples:
-- leftpad "foo" 5 ==> " foo"
-- leftpad "13" 3 ==> " 13"
-- leftpad "xxxxx" 3 ==> "xxxxx"
--
-- Tips:
-- * you can combine strings with the ++ operator.
-- * you can compute the length of a string with the length function
leftpad :: String -> Int -> String
leftpad x n
| (length x >= n) = x
| (length x < n) = " " ++ leftpad x (n-1)
------------------------------------------------------------------------------
-- Ex 5: let's make a countdown for a rocket! Given a number, you
-- should produce a string that says "Ready!", counts down from the
-- number, and then says "Liftoff!".
--
-- For example,
-- countdown 4 ==> "Ready! 4... 3... 2... 1... Liftoff!"
--
-- Hints:
-- * you can combine strings with the ++ operator
-- * you can use the show function to convert a number into a string
-- * you'll probably need a recursive helper function
countdown :: Integer -> String
countdown x = let y = helpr x
in "Ready!" ++ y ++ "Liftoff!"
where
helpr 0 = " "
helpr n = " " ++show n ++ "..." ++ helpr (n-1)
------------------------------------------------------------------------------
-- Ex 6: implement the function smallestDivisor that returns the
-- smallest number (greater than 1) that divides the given number evenly.
--
-- That is, when
-- smallestDivisor n ==> k
-- we have
-- n = t*k
-- for some t.
--
-- Ps. your function doesn't need to work for inputs 0 and 1, but
-- remember this in the next exercise!
--
-- Hint: remember the mod function!
smallestDivisor :: Integer -> Integer
smallestDivisor n = head [x | x <- [2..n], mod n x == 0]
------------------------------------------------------------------------------
-- Ex 7: implement a function isPrime that checks if the given number
-- is a prime number. Use the function smallestDivisor.
--
-- Ps. 0 and 1 are not prime numbers
isPrime :: Integer -> Bool
isPrime 0 = False
isPrime 1 = False
isPrime x = smallestDivisor x == x
------------------------------------------------------------------------------
-- Ex 8: implement a function biggestPrimeAtMost that returns the
-- biggest prime number that is less than or equal to the given
-- number. Use the function isPrime you just defined.
--
-- You don't need to care about arguments less than 2. Any behaviour
-- for them is fine.
--
-- Examples:
-- biggestPrimeAtMost 3 ==> 3
-- biggestPrimeAtMost 10 ==> 7
biggestPrimeAtMost :: Integer -> Integer
biggestPrimeAtMost n = last [x | x <- [1..n], isPrime x == True]3 Lists
-- Exercise set 3a
--
-- * lists
-- * functional programming
import Data.Char
import Data.Either
import Data.List
------------------------------------------------------------------------------
-- Ex 1: implement the function maxBy that takes as argument a
-- measuring function (of type a -> Int) and two values (of type a).
--
-- maxBy should apply the measuring function to both arguments and
-- return the argument for which the measuring function returns a
-- higher value.
--
-- Examples:
--
-- maxBy (*2) 3 5 ==> 5
-- maxBy length [1,2,3] [4,5] ==> [1,2,3]
-- maxBy head [1,2,3] [4,5] ==> [4,5]
maxBy :: (a -> Int) -> a -> a -> a
maxBy measure a b
| measure a >= measure b = a
| otherwise = b
------------------------------------------------------------------------------
-- Ex 2: implement the function mapMaybe that takes a function and a
-- Maybe value. If the value is Nothing, it returns Nothing. If it is
-- a Just, it updates the contained value using the function.
--
-- Examples:
-- mapMaybe length Nothing ==> Nothing
-- mapMaybe length (Just "abc") ==> Just 3
mapMaybe :: (a -> b) -> Maybe a -> Maybe b
mapMaybe f Nothing = Nothing
mapMaybe f (Just x) = (Just (f x))
------------------------------------------------------------------------------
-- Ex 3: implement the function mapMaybe2 that works like mapMaybe
-- except it combines two Maybe values using a function of two
-- arguments.
--
-- Examples:
-- mapMaybe2 take (Just 2) (Just "abcd") ==> Just "ab"
-- mapMaybe2 div (Just 6) (Just 3) ==> Just 2
-- mapMaybe2 div Nothing (Just 3) ==> Nothing
-- mapMaybe2 div (Just 6) Nothing ==> Nothing
mapMaybe2 :: (a -> b -> c) -> Maybe a -> Maybe b -> Maybe c
mapMaybe2 f Nothing y = Nothing
mapMaybe2 f x Nothing = Nothing
mapMaybe2 f (Just x) (Just y) = Just (f x y)
------------------------------------------------------------------------------
-- Ex 4: define the functions firstHalf and palindrome so that
-- palindromeHalfs returns the first halfs of all palindromes in its
-- input.
--
-- The first half of a string should include the middle character of
-- the string if the string has an odd length.
--
-- Examples:
-- palindromeHalfs ["abba", "cat", "racecar"]
-- ==> ["ab","race"]
--
-- What types should firstHalf and palindrome have? Give them type
-- annotations.
--
-- Note! Do not change the definition of palindromeHalfs
palindromeHalfs :: [String] -> [String]
palindromeHalfs xs = map firstHalf (filter palindrome xs)
firstHalf :: String -> String
firstHalf "" = ""
firstHalf (x:xs)
| odd (length (x:xs)) = x: halfhelp xs
| even (length (x:xs)) = halfhelp (x:xs)
where halfhelp y = take (div (length y) 2) y
palindrome :: String -> Bool
palindrome "" = True
palindrome x = reverse x == x
------------------------------------------------------------------------------
-- Ex 5: Implement a function capitalize that takes in a string and
-- capitalizes the first letter of each word in it.
--
-- You should probably define a helper function capitalizeFirst that
-- capitalizes the first letter of a string.
--
-- These functions will help:
-- - toUpper :: Char -> Char from the module Data.Char
-- - words :: String -> [String]
-- - unwords :: [String] -> String
--
-- Example:
-- capitalize "goodbye cruel world" ==> "Goodbye Cruel World"
capitalize :: String -> String
capitalize x = unwords $ map (\a -> (toUpper (head a)):(tail a)) (words x)
------------------------------------------------------------------------------
-- Ex 6: powers k max should return all the powers of k that are less
-- than or equal to max. For example:
--
-- powers 2 5 ==> [1,2,4]
-- powers 3 30 ==> [1,3,9,27]
-- powers 2 2 ==> [1,2]
--
-- You can assume that k is at least 2.
--
-- Hints:
-- * k^max > max
-- * the function takeWhile
powers :: Int -> Int -> [Int]
powers k max = takeWhile (\x -> x <= max) [k^x | x <- [0..(div max k)]]
------------------------------------------------------------------------------
-- Ex 7: implement a functional while loop. While should be a function
-- that takes a checking function, an updating function, and an
-- initial value. While should repeatedly apply the updating function
-- to the initial value as long as the value passes the checking
-- function. Finally, the value that doesn't pass the check is
-- returned.
--
-- Examples:
--
-- while odd (+1) 1 ==> 2
--
-- while (<=4) (+1) 0 ==> 5
--
-- let check [] = True
-- check ('A':xs) = False
-- check _ = True
-- in while check tail "xyzAvvt"
-- ==> Avvt
while :: (a->Bool) -> (a->a) -> a -> a
while check update value
| check value == True = while check update (update value)
| check value == False = value
------------------------------------------------------------------------------
-- Ex 8: another version of a while loop. This time, the check
-- function returns an Either value. A Left value means stop, a Right
-- value means keep looping.
--
-- The call `whileRight check x` should call `check x`, and if the
-- result is a Left, return the contents of the Left. If the result is
-- a Right, the function should call `check` on the contents of the
-- Right and so on.
--
-- Examples (see definition of step below):
-- whileRight (step 100) 1 ==> 128
-- whileRight (step 1000) 3 ==> 1536
whileRight :: (a -> Either b a) -> a -> b
whileRight f x = case f x of Left p -> p
Right q -> whileRight f q
-- for the whileRight examples:
-- step k x doubles x if it's less than k
step :: Int -> Int -> Either Int Int
step k x = if x<k then Right (2*x) else Left x
------------------------------------------------------------------------------
-- Ex 9: given a list of strings and a length, return all strings that
-- * have the given length
-- * are made by catenating two input strings
--
-- Examples:
-- joinToLength 2 ["a","b","cd"] ==> ["aa","ab","ba","bb"]
-- joinToLength 5 ["a","b","cd","def"] ==> ["cddef","defcd"]
--
-- Hint! This is a great use for list comprehensions
joinToLength :: Int -> [String] -> [String]
joinToLength x y = [a++b | a<- y, b <- y, ((length a) + (length b)) == x ]
------------------------------------------------------------------------------
-- Ex 10: implement the operator +|+ that returns a list with the first
-- elements of its input lists.
--
-- Give +|+ a type signature. NB: It needs to be of the form (+|+) :: x,
-- with the parentheses because +|+ is an infix operator.
--
-- Examples:
-- [1,2,3] +|+ [4,5,6] ==> [1,4]
-- [] +|+ [True] ==> [True]
-- [] +|+ [] ==> []
(+|+) :: Eq a => [a] -> [a] -> [a]
(+|+) [] [] = []
(+|+) x [] = [head x]
(+|+) [] y = [head y]
(+|+) x y = [head x, head y]
------------------------------------------------------------------------------
-- Ex 11: remember the lectureParticipants example from Lecture 2? We
-- used a value of type [Either String Int] to store some measurements
-- that might be missing. Implement the function sumRights which sums
-- all non-missing measurements in a list like this.
--
-- Challenge: look up the type of the either function. Implement
-- sumRights using the map & either functions instead of pattern
-- matching on lists or Eithers!
--
-- Examples:
-- sumRights [Right 1, Left "bad value", Right 2] ==> 3
-- sumRights [Left "bad!", Left "missing"] ==> 0
sumRights :: [Either a Int] -> Int
sumRights x = sum $ map (\z -> case z of Right p -> p ; Left q -> 0 ) x
------------------------------------------------------------------------------
-- Ex 12: recall the binary function composition operation
-- (f . g) x = f (g x). In this exercise, your task is to define a function
-- that takes any number of functions given as a list and composes them in the
-- same order than they appear in the list.
--
-- Examples:
-- multiCompose [] "foo" ==> "foo"
-- multiCompose [] 1 ==> 1
-- multiCompose [(++"bar")] "foo" ==> "foobar"
-- multiCompose [reverse, tail, (++"bar")] "foo" ==> "raboo"
-- multiCompose [(3*), (2^), (+1)] 0 ==> 6
-- multiCompose [(+1), (2^), (3*)] 0 ==> 2
multiCompose :: [a -> a] -> a -> a
multiCompose fs x = foldr (.) id fs x
------------------------------------------------------------------------------
-- Ex 13: let's consider another way to compose multiple functions. Given
-- some function f, a list of functions gs, and some value x, define
-- a composition operation that applies each function g in gs to x and then
-- f to the resulting list. Give also the type annotation for multiApp.
--
-- Challenge: Try implementing multiApp without lambdas or list comprehensions.
--
-- Examples:
-- multiApp id [] 7 ==> []
-- multiApp id [id, reverse, tail] "This is a test"
-- ==> ["This is a test","tset a si sihT","his is a test"]
-- multiApp id [(1+), (^3), (+2)] 1 ==> [2,1,3]
-- multiApp sum [(1+), (^3), (+2)] 1 ==> 6
-- multiApp reverse [tail, take 2, reverse] "foo" ==> ["oof","fo","oo"]
-- multiApp concat [take 3, reverse] "race" ==> "racecar"
multiApp :: ([b]->c)->[a->b]->a->c
multiApp f gs x = f (map (\p -> p x) gs)
------------------------------------------------------------------------------
-- Ex 14: in this exercise you get to implement an interpreter for a
-- simple language. You should keep track of the x and y coordinates,
-- and interpret the following commands:
--
-- up -- increment y by one
-- down -- decrement y by one
-- left -- decrement x by one
-- right -- increment x by one
-- printX -- print value of x
-- printY -- print value of y
--
-- The interpreter will be a function of type [String] -> [String].
-- Its input is a list of commands, and its output is a list of the
-- results of the print commands in the input.
--
-- Both coordinates start at 0.
--
-- Examples:
--
-- interpreter ["up","up","up","printY","down","printY"] ==> ["3","2"]
-- interpreter ["up","right","right","printY","printX"] ==> ["1","2"]
--
-- Surprise! after you've implemented the function, try running this in GHCi:
-- interact (unlines . interpreter . lines)
-- after this you can enter commands on separate lines and see the
-- responses to them
--
-- The suprise will only work if you generate the return list directly
-- using (:). If you build the list in an argument to a helper
-- function, the surprise won't work.
interpreter :: [String] -> [String]
interpreter [] = []
interpreter (w:ws) =
som (w:ws) [] (0,0)
where
som [] b c = b
som (a:ax) b c
| a == "up" = som ax b (fst c, snd c + 1)
| a == "printY" = som ax (b ++ [show (snd c)]) c
| a == "printX" = som ax (b ++ [show (fst c)]) c
| a == "right" = som ax b (fst c + 1, snd c)
| a == "left" = som ax b (fst c - 1, snd c)
| a == "down" = som ax b (fst c, snd c - 1)4 Pattern Match
-- Exercise set 3b
--
-- This is a special exercise set. The exercises are about
-- implementing list functions using recursion and pattern matching,
-- without using any standard library functions. For this reason,
-- you'll be working in a limited environment where almost none of the
-- standard library is available.
--
-- At least the following standard library functions are missing:
-- * (++)
-- * head
-- * tail
-- * map
-- * filter
-- * concat
-- * (!!)
--
-- The (:) operator is available, as is list literal syntax [a,b,c].
--
-- Feel free to use if-then-else, guards, and ordering functions (< and > etc.).
{-# LANGUAGE NoImplicitPrelude #-}
------------------------------------------------------------------------------
-- Ex 1: given numbers start, count and end, build a list that starts
-- with count copies of start and ends with end.
--
-- Use recursion and the : operator to build the list.
--
-- Examples:
-- buildList 1 5 2 ==> [1,1,1,1,1,2]
-- buildList 7 0 3 ==> [3]
buildList :: Int -> Int -> Int -> [Int]
buildList x 0 z = [z]
buildList x n z = x:(buildList x (n-1) z)
------------------------------------------------------------------------------
-- Ex 2: given i, build the list of sums [1, 1+2, 1+2+3, .., 1+2+..+i]
--
-- Use recursion and the : operator to build the list.
--
-- Ps. you'll probably need a recursive helper function
sums :: Int -> [Int]
sums i = sumsH i []
where
sumsH s x
| s == 0 = x
| otherwise = sumsH (s-1) ((suf s):x)
where
suf 0 = 0
suf n = n + suf (n-1)
------------------------------------------------------------------------------
-- Ex 3: define a function mylast that returns the last value of the
-- given list. For an empty list, a provided default value is
-- returned.
--
-- Use only pattern matching and recursion (and the list constructors : and [])
--
-- Examples:
-- mylast 0 [] ==> 0
-- mylast 0 [1,2,3] ==> 3
mylast :: a -> [a] -> a
mylast def [] = def
mylast def (x:[]) = x
mylast def (x:xs) = mylast def xs
------------------------------------------------------------------------------
-- Ex 4: safe list indexing. Define a function indexDefault so that
-- indexDefault xs i def
-- gets the element at index i in the list xs. If i is not a valid
-- index, def is returned.
--
-- Use only pattern matching and recursion (and the list constructors : and [])
--
-- This time, implement indexDefault using pattern matching and
-- recursion.
--
-- Examples:
-- indexDefault [True] 1 False ==> False
-- indexDefault [10,20,30] 0 7 ==> 10
-- indexDefault [10,20,30] 2 7 ==> 30
-- indexDefault [10,20,30] 3 7 ==> 7
-- indexDefault ["a","b","c"] (-1) "d" ==> "d"
indexDefault :: [a] -> Int -> a -> a
indexDefault (x:xs) 0 def = x
indexDefault [] i def = def
indexDefault (x:xs) i def = indexDefault xs (i-1) def
------------------------------------------------------------------------------
-- Ex 5: define a function that checks if the given list is in
-- increasing order.
--
-- Use pattern matching and recursion to iterate through the list.
sorted :: [Int] -> Bool
sorted [] = True
sorted (x:[]) = True
sorted (x:a:xs) = if x <= a then sorted (a:xs) else False
------------------------------------------------------------------------------
-- Ex 6: compute the partial sums of the given list like this:
--
-- sumsOf [a,b,c] ==> [a,a+b,a+b+c]
-- sumsOf [a,b] ==> [a,a+b]
-- sumsOf [] ==> []
--
-- Use pattern matching and recursion (and the list constructors : and [])
sumsOf :: [Int] -> [Int]
sumsOf [] = []
sumsOf (x:xs) = x:(mapsum x (sumsOf xs))
where
mapsum n [] = []
mapsum n (a:ax) = (n+a):mapsum n ax
------------------------------------------------------------------------------
-- Ex 7: implement the function merge that merges two sorted lists of
-- Ints into a sorted list
--
-- Use only pattern matching and recursion (and the list constructors : and [])
--
-- Examples:
-- merge [1,3,5] [2,4,6] ==> [1,2,3,4,5,6]
-- merge [1,1,6] [1,2] ==> [1,1,1,2,6]
merge :: [Int] -> [Int] -> [Int]
merge a [] = a
merge [] b = b
merge (x:xs) (y:ys)
| x <= y = x:(merge xs (y:ys))
| otherwise = y:(merge (x:xs) ys)
------------------------------------------------------------------------------
-- Ex 8: define the function mymaximum that takes a list and a
-- function bigger :: a -> a -> Bool and returns the
-- biggest of the list, according to the comparing function.
--
-- An initial biggest value is provided to give you something to
-- return for empty lists.
--
-- Examples:
-- mymaximum (>) 3 [] ==> 3
-- mymaximum (>) 0 [1,3,2] ==> 3
-- mymaximum (>) 4 [1,3,2] ==> 4 -- initial value was biggest
-- mymaximum (<) 4 [1,3,2] ==> 1 -- note changed biggerThan
-- mymaximum (\xs ys -> length xs > length ys) [] [[1,2],[3]]
-- ==> [1,2]
mymaximum :: (a -> a -> Bool) -> a -> [a] -> a
mymaximum x y [] = y
mymaximum x y [z] = if x y z then y else z
mymaximum bigger initial (x:xa:xs)
|bigger x xa = mymaximum bigger initial (x:xs)
|otherwise = mymaximum bigger initial (xa:xs)
------------------------------------------------------------------------------
-- Ex 9: define a version of map that takes a two-argument function
-- and two lists. Example:
--
-- map2 f [x,y,z,w] [a,b,c] ==> [f x a, f y b, f z c]
--
-- If the lists have differing lengths, ignore the trailing elements
-- of the longer list.
--
-- Use recursion and pattern matching. Do not use any library functions.
map2 :: (a -> b -> c) -> [a] -> [b] -> [c]
map2 f xs [] = []
map2 f [] ys = []
map2 f (x:as) (y:bs) = (f x y):(map2 f as bs)
------------------------------------------------------------------------------
-- Ex 10: implement the function maybeMap, which works a bit like a
-- combined map & filter.
---
-- maybeMap is given a list ([a]) and a function of type a -> Maybe b.
-- This function is called for all values in the list. If the function
-- returns Just x, x will be in the result list. If the function
-- returns Nothing, no value gets added to the result list.
--
-- Examples:
--
-- let f x = if x>0 then Just (2*x) else Nothing
-- in maybeMap f [0,1,-1,4,-2,2]
-- ==> [2,8,4]
--
-- maybeMap Just [1,2,3]
-- ==> [1,2,3]
--
-- maybeMap (\x -> Nothing) [1,2,3]
-- ==> []
maybeMap :: (a -> Maybe b) -> [a] -> [b]
maybeMap f [] = []
maybeMap f (x:xs) = case f x of
Just z -> z:(maybeMap f xs)
Nothing -> maybeMap f xs
5 Typeclass
-- Exercise set 4a:
--
-- * using type classes
-- * working with lists
--
-- Type classes you'll need
-- * Eq
-- * Ord
-- * Num
-- * Fractional
--
-- Useful functions:
-- * maximum
-- * minimum
-- * sort
import Data.List
import Data.Ord
import qualified Data.Map as Map
import Data.Array
------------------------------------------------------------------------------
-- Ex 1: implement the function allEqual which returns True if all
-- values in the list are equal.
--
-- Examples:
-- allEqual [] ==> True
-- allEqual [1,2,3] ==> False
-- allEqual [1,1,1] ==> True
--
-- PS. check out the error message you get with your implementation if
-- you remove the Eq a => constraint from the type!
allEqual :: Eq a => [a] -> Bool
allEqual [] = True
allEqual (x:[]) = True
allEqual (x:y:xs) = x == y && allEqual xs
------------------------------------------------------------------------------
-- Ex 2: implement the function distinct which returns True if all
-- values in a list are different.
--
-- Hint: a certain function from the lecture material can make this
-- really easy for you.
--
-- Examples:
-- distinct [] ==> True
-- distinct [1,1,2] ==> False
-- distinct [1,2] ==> True
distinct :: Eq a => [a] -> Bool
--distinct (x:xs) = foldl (\a b -> (notElem x (distinct xs)) && b ) True (x:xs)
distinct [] = True
distinct (x:xs) = (notElem x xs) && (distinct xs)
------------------------------------------------------------------------------
-- Ex 3: implement the function middle that returns the middle value
-- (not the smallest or the largest) out of its three arguments.
--
-- The function should work on all types in the Ord class. Give it a
-- suitable type signature.
--
-- Examples:
-- middle 'b' 'a' 'c' ==> 'b'
-- middle 1 7 3 ==> 3
middle :: Ord a => a -> a -> a -> a
middle x y z = (sorti [x,y,z]) !! 1
where
sorti :: Ord a => [a] -> [a]
sorti [] = []
sorti (p:[]) = (p:[])
sorti (p:ps) =
let fh = [k | k <- ps, k <= p]
sh = [k | k <- ps, k > p]
in sorti fh ++ [p] ++ sorti sh
------------------------------------------------------------------------------
-- Ex 4: return the range of an input list, that is, the difference
-- between the smallest and the largest element.
--
-- Your function should work on all suitable types, like Float and
-- Int. You'll need to add _class constraints_ to the type of range.
--
-- It's fine if your function doesn't work for empty inputs.
--
-- Examples:
-- rangeOf [4,2,1,3] ==> 3
-- rangeOf [1.5,1.0,1.1,1.2] ==> 0.5
rangeOf :: (Num a ,Ord a) => [a] -> a
rangeOf x = ((head . reverse) $ (sort x)) - (head $ (sort x))
------------------------------------------------------------------------------
-- Ex 5: given a list of lists, return the longest list. If there
-- are multiple lists of the same length, return the list that has
-- the smallest _first element_.
--
-- (If multiple lists have the same length and same first element,
-- you can return any one of them.)
--
-- Give the longest function a suitable type.
--
-- Examples:
-- longest [[1,2,3],[4,5],[6]] ==> [1,2,3]
-- longest ["bcd","def","ab"] ==> "bcd"
longest :: (Ord a) => [[a]] -> [a]
longest x = foldl (\x y -> if (head x) < (head y) then x else y) base llst
where
llst = [ k | k <- x, length k == (maximum $ map (\a -> length a) x)]
base = head llst
------------------------------------------------------------------------------
-- Ex 6: Implement the function incrementKey, that takes a list of
-- (key,value) pairs, and adds 1 to all the values that have the given key.
--
-- You'll need to add _class constraints_ to the type of incrementKey
-- to make the function work!
--
-- The function needs to be generic and handle all compatible types,
-- see the examples.
--
-- Examples:
-- incrementKey True [(True,1),(False,3),(True,4)] ==> [(True,2),(False,3),(True,5)]
-- incrementKey 'a' [('a',3.4)] ==> [('a',4.4)]
incrementKey :: (Eq k, Num v) => k -> [(k,v)] -> [(k,v)]
incrementKey x [] = []
incrementKey x (y:ys)
| x == fst y = (x,snd y + 1):incrementKey x ys
| otherwise = y:incrementKey x ys
------------------------------------------------------------------------------
-- Ex 7: compute the average of a list of values of the Fractional
-- class.
--
-- There is no need to handle the empty list case.
--
-- Hint! since Fractional is a subclass of Num, you have all
-- arithmetic operations available
--
-- Hint! you can use the function fromIntegral to convert the list
-- length to a Fractional
average :: Fractional a => [a] -> a
average xs = (sum xs) / (fromIntegral (length xs))
------------------------------------------------------------------------------
-- Ex 8: given a map from player name to score and two players, return
-- the name of the player with more points. If the players are tied,
-- return the name of the first player (that is, the name of the
-- player who comes first in the argument list, player1).
--
-- If a player doesn't exist in the map, you can assume they have 0 points.
--
-- Hint: Map.findWithDefault can make this simpler
--
-- Examples:
-- winner (Map.fromList [("Bob",3470),("Jane",2130),("Lisa",9448)]) "Jane" "Lisa"
-- ==> "Lisa"
-- winner (Map.fromList [("Mike",13607),("Bob",5899),("Lisa",5899)]) "Lisa" "Bob"
-- ==> "Lisa"
winner :: Map.Map String Int -> String -> String -> String
winner scores player1 player2 = if (Map.findWithDefault 0 player1 scores) >= (Map.findWithDefault 0 player2 scores)
then player1 else player2
------------------------------------------------------------------------------
-- Ex 9: compute how many times each value in the list occurs. Return
-- the frequencies as a Map from value to Int.
--
-- Challenge 1: try using Map.alter for this
--
-- Challenge 2: use foldr to process the list
--
-- Example:
-- freqs [False,False,False,True]
-- ==> Map.fromList [(False,3),(True,1)]
freqs :: (Eq a, Ord a) => [a] -> Map.Map a Int
freqs xs = foldr (\a b -> if Map.lookup a b == Nothing then Map.insert a 1 b else Map.adjust (\x -> x + 1) a b ) (Map.fromList []) xs
------------------------------------------------------------------------------
-- Ex 10: recall the withdraw example from the course material. Write a
-- similar function, transfer, that transfers money from one account
-- to another.
--
-- However, the function should not perform the transfer if
-- * the from account doesn't exist,
-- * the to account doesn't exist,
-- * the sum is negative,
-- * or the from account doesn't have enough money.
--
-- Hint: there are many ways to implement this logic. Map.member or
-- Map.notMember might help.
--
-- Examples:
-- let bank = Map.fromList [("Bob",100),("Mike",50)]
-- transfer "Bob" "Mike" 20 bank
-- ==> fromList [("Bob",80),("Mike",70)]
-- transfer "Bob" "Mike" 120 bank
-- ==> fromList [("Bob",100),("Mike",50)]
-- transfer "Bob" "Lisa" 20 bank
-- ==> fromList [("Bob",100),("Mike",50)]
-- transfer "Lisa" "Mike" 20 bank
-- ==> fromList [("Bob",100),("Mike",50)]
transfer :: String -> String -> Int -> Map.Map String Int -> Map.Map String Int
transfer from to amount bank =
if Map.member from bank && Map.member to bank && (Map.lookup from bank) >= Just amount && amount >= 0 then
Map.adjust (\y -> y + amount) to (Map.adjust (\x -> x - amount) from bank)
else bank
------------------------------------------------------------------------------
-- Ex 11: given an Array and two indices, swap the elements in the indices.
--
-- Example:
-- swap 2 3 (array (1,4) [(1,"one"),(2,"two"),(3,"three"),(4,"four")])
-- ==> array (1,4) [(1,"one"),(2,"three"),(3,"two"),(4,"four")]
swap :: Ix i => i -> i -> Array i a -> Array i a
swap i j arr = arr // [(i, arr ! j), (j, arr ! i)]
------------------------------------------------------------------------------
-- Ex 12: given an Array, find the index of the largest element. You
-- can assume the Array isn't empty.
--
-- You may assume that the largest element is unique.
--
-- Hint: check out Data.Array.indices or Data.Array.assocs
maxIndex :: (Ix i, Ord a) => Array i a -> i
maxIndex g = (fst . head) [x | x <- assocs g, snd x == maximum g] 6 Folds
-- Exercise set 4b: folds
------------------------------------------------------------------------------
-- Ex 1: countNothings with a fold. The function countNothings from
-- the course material can be implemented using foldr. Your task is to
-- define countHelper so that the following definition of countNothings
-- works.
--
-- Hint: You can start by trying to add a type signature for countHelper.
--
-- Challenge: look up the maybe function and use it in countHelper.
--
-- Examples:
-- countNothings [] ==> 0
-- countNothings [Just 1, Nothing, Just 3, Nothing] ==> 2
countNothings :: [Maybe a] -> Int
countNothings xs = foldr countHelper 0 xs
countHelper :: Num b=> Maybe a -> b -> b
countHelper Nothing xa = 1 + xa
countHelper (Just x) xa = xa
------------------------------------------------------------------------------
-- Ex 2: myMaximum with a fold. Just like in the previous exercise,
-- define maxHelper so that the given definition of myMaximum works.
--
-- Examples:
-- myMaximum [] ==> 0
-- myMaximum [1,3,2] ==> 3
myMaximum :: [Int] -> Int
myMaximum [] = 0
myMaximum (x:xs) = foldr maxHelper x xs
maxHelper :: (Ord a) => a -> a -> a
maxHelper x y = max x y
------------------------------------------------------------------------------
-- Ex 3: compute the sum and length of a list with a fold. Define
-- slHelper and slStart so that the given definition of sumAndLength
-- works. This could be used to compute the average of a list.
--
-- Start by giving slStart and slHelper types.
--
-- Examples:
-- sumAndLength [] ==> (0.0,0)
-- sumAndLength [1.0,2.0,4.0] ==> (7.0,3)
sumAndLength :: [Double] -> (Double,Int)
sumAndLength xs = foldr slHelper slStart xs
slStart :: (Double, Int)
slStart = (0.0,0)
slHelper :: (Num a, Num b) => a -> (a, b) -> (a, b)
slHelper x y = (x + (fst y), snd y + 1)
------------------------------------------------------------------------------
-- Ex 4: implement concat with with a fold. Define concatHelper and
-- concatStart so that the given definition of myConcat joins inner lists
-- of a list.
--
-- Examples:
-- myConcat [[]] ==> []
-- myConcat [[1,2,3],[4,5],[6]] ==> [1,2,3,4,5,6]
myConcat :: [[a]] -> [a]
myConcat xs = foldr concatHelper concatStart xs
concatStart :: [a]
concatStart = []
concatHelper :: [a] -> [a] -> [a]
concatHelper x xb = x ++ xb
------------------------------------------------------------------------------
-- Ex 5: get all occurrences of the largest number in a list with a
-- fold. Implement largestHelper so that the given definition of largest works.
--
-- Examples:
-- largest [] ==> []
-- largest [1,3,2] ==> [3]
-- largest [1,3,2,3] ==> [3,3]
largest :: [Int] -> [Int]
largest xs = foldr largestHelper [] xs
largestHelper :: Ord a => a -> [a] -> [a]
largestHelper x xa
| xa == [] = x:[]
| x > (head xa) = x:[]
| x == (head xa) = (x:xa)
| otherwise = xa
------------------------------------------------------------------------------
-- Ex 6: get the first element of a list with a fold. Define
-- headHelper so that the given definition of myHead works.
--
-- Start by giving headHelper a type.
--
-- Examples:
-- myHead [] ==> Nothing
-- myHead [1,2,3] ==> Just 1
myHead :: [a] -> Maybe a
myHead xs = foldr headHelper Nothing xs
headHelper :: a -> Maybe a -> Maybe a
headHelper x Nothing = Just x
headHelper x (Just z) = Just x
------------------------------------------------------------------------------
-- Ex 7: get the last element of a list with a fold. Define lasthelper
-- so that the given definition of myLast works.
--
-- Start by giving lastHelper a type.
--
-- Examples:
-- myLast [] ==> Nothing
-- myLast [1,2,3] ==> Just 3
myLast :: [a] -> Maybe a
myLast xs = foldr lastHelper Nothing xs
lastHelper :: a -> Maybe a -> Maybe a
lastHelper x Nothing = Just x
lastHelper x (Just z) = Just z7 Algebraic Datatype
-- Exercise set 5a
--
-- * defining algebraic datatypes
-- * recursive datatypes
------------------------------------------------------------------------------
-- Ex 1: Define the type Vehicle that has four constructors: Bike,
-- Bus, Tram and Train.
--
-- The constructors don't need any fields.
data Vehicle = Bike | Bus | Tram | Train
------------------------------------------------------------------------------
-- Ex 2: Define the type BusTicket that can represent values like these:
-- - SingleTicket
-- - MonthlyTicket "January"
-- - MonthlyTicket "December"
data BusTicket = SingleTicket | MonthlyTicket String
------------------------------------------------------------------------------
-- Ex 3: Here's the definition for a datatype ShoppingEntry that
-- represents an entry in a shopping basket. It has an item name (a
-- String), an item price (a Double) and a count (an Int). You'll also
-- find two examples of ShoppingEntry values.
--
-- Implement the functions totalPrice and buyOneMore below.
data ShoppingEntry = MkShoppingEntry String Double Int
deriving Show
threeApples :: ShoppingEntry
threeApples = MkShoppingEntry "Apple" 0.5 3
twoBananas :: ShoppingEntry
twoBananas = MkShoppingEntry "Banana" 1.1 2
-- totalPrice should return the total price for an entry
--
-- Hint: you'll probably need fromIntegral to convert the Int into a
-- Double
--
-- Examples:
-- totalPrice threeApples ==> 1.5
-- totalPrice twoBananas ==> 2.2
totalPrice :: ShoppingEntry -> Double
totalPrice (MkShoppingEntry x y z) = (y * fromIntegral z)
-- buyOneMore should increment the count in an entry by one
--
-- Example:
-- buyOneMore twoBananas ==> MkShoppingEntry "Banana" 1.1 3
buyOneMore :: ShoppingEntry -> ShoppingEntry
buyOneMore (MkShoppingEntry x y z)= MkShoppingEntry x y (z+1)
------------------------------------------------------------------------------
-- Ex 4: define a datatype Person, which should contain the age (an
-- Int) and the name (a String) of a person.
--
-- Also define a Person value fred, and the functions getAge, getName,
-- setAge and setName (see below).
data Person = Bperson String Int
deriving Show
-- fred is a person whose name is Fred and age is 90
fred :: Person
fred = Bperson "Fred" 90
-- getName returns the name of the person
getName :: Person -> String
getName (Bperson x y) = x
-- getAge returns the age of the person
getAge :: Person -> Int
getAge (Bperson x y) = y
-- setName takes a person and returns a new person with the name changed
setName :: String -> Person -> Person
setName x (Bperson a b) = Bperson x b
-- setAge does likewise for age
setAge :: Int -> Person -> Person
setAge x (Bperson a b) = Bperson a x
------------------------------------------------------------------------------
-- Ex 5: define a datatype Position which contains two Int values, x
-- and y. Also define the functions below for operating on a Position.
--
-- Examples:
-- getY (up (up origin)) ==> 2
-- getX (up (right origin)) ==> 1
data Position = Pos Int Int
-- origin is a Position value with x and y set to 0
origin :: Position
origin = Pos 0 0
-- getX returns the x of a Position
getX :: Position -> Int
getX (Pos x y) = x
-- getY returns the y of a position
getY :: Position -> Int
getY (Pos x y)= y
-- up increases the y value of a position by one
up :: Position -> Position
up (Pos x y)= Pos x (y+1)
-- right increases the x value of a position by one
right :: Position -> Position
right (Pos x y)= Pos (x+1) y
------------------------------------------------------------------------------
-- Ex 6: Here's a datatype that represents a student. A student can
-- either be a freshman, a nth year student, or graduated.
data Student = Freshman | NthYear Int | Graduated
deriving (Show,Eq)
-- Implement the function study, which changes a Freshman into a 1st
-- year student, a 1st year student into a 2nd year student, and so
-- on. A 7th year student gets changed to a graduated student. A
-- graduated student stays graduated even if he studies.
study :: Student -> Student
study Freshman = NthYear 1
study (NthYear 7) = Graduated
study (NthYear x) = NthYear (x+1)
study Graduated = Graduated
------------------------------------------------------------------------------
-- Ex 7: define a datatype UpDown that represents a counter that can
-- either be in increasing or decreasing mode. Also implement the
-- functions zero, toggle, tick and get below.
--
-- NB! Define _two_ constructors for your datatype (feel free to name the
-- constructors however you want)
--
-- Examples:
--
-- get (tick zero)
-- ==> 1
-- get (tick (tick zero))
-- ==> 2
-- get (tick (tick (toggle (tick zero))))
-- ==> -1
data UpDown = Up Int | Down Int
-- zero is an increasing counter with value 0
zero :: UpDown
zero = Up 0
-- get returns the counter value
get :: UpDown -> Int
get (Up x) = x
get (Down x) = x
-- tick increases an increasing counter by one or decreases a
-- decreasing counter by one
tick :: UpDown -> UpDown
tick (Up x) = Up (x+1)
tick (Down x) = Down (x-1)
-- toggle changes an increasing counter into a decreasing counter and
-- vice versa
toggle :: UpDown -> UpDown
toggle (Up x) = Down x
------------------------------------------------------------------------------
-- Ex 8: you'll find a Color datatype below. It has the three basic
-- colours Red, Green and Blue, and two color transformations, Mix and
-- Invert.
--
-- Mix means the average of the two colors in each rgb channel.
--
-- Invert means subtracting all rgb values from 1.
--
-- Implement the function rgb :: Color -> [Double] that returns a list
-- of length three that represents the rgb value of the given color.
--
-- Examples:
--
-- rgb Red ==> [1,0,0]
-- rgb Green ==> [0,1,0]
-- rgb Blue ==> [0,0,1]
--
-- rgb (Mix Red Green) ==> [0.5,0.5,0]
-- rgb (Mix Red (Mix Red Green)) ==> [0.75,0.25,0]
-- rgb (Invert Red) ==> [0,1,1]
-- rgb (Invert (Mix Red (Mix Red Green))) ==> [0.25,0.75,1]
-- rgb (Mix (Invert Red) (Invert Green)) ==> [0.5,0.5,1]
data Color = Red | Green | Blue | Mix Color Color | Invert Color
deriving Show
rgb :: Color -> [Double]
rgb Red = [1,0,0]
rgb Green = [0,1,0]
rgb Blue = [0,0,1]
rgb (Mix x y) = map (\x -> (fst x + snd x)/2) $ zip (rgb x) (rgb y)
rgb (Invert x) = map (\x -> 1 - x) (rgb x)
------------------------------------------------------------------------------
-- Ex 9: define a parameterized datatype OneOrTwo that contains one or
-- two values of the given type. The constructors should be called One and Two.
--
-- Examples:
-- One True :: OneOrTwo Bool
-- Two "cat" "dog" :: OneOrTwo String
data OneOrTwo a = One a | Two a a
------------------------------------------------------------------------------
-- Ex 10: define a recursive datatype KeyVals for storing a set of
-- key-value pairs. There should be two constructors: Empty and Pair.
--
-- Empty represents an empty collection. It should have no fields.
--
-- Pair should have three fields, one for the key, one for the value,
-- and one for the rest of the collection (of type KeyVals)
--
-- The KeyVals datatype is parameterized by the key type k and
-- the value type v.
--
-- For example:
--
-- Pair "cat" True (Pair "dog" False Empty) :: KeyVals String Bool
--
-- Also define the functions toList and fromList that convert between
-- KeyVals and lists of pairs.
data KeyVals k v = Empty | Pair k v (KeyVals k v)
deriving Show
toList :: KeyVals k v -> [(k,v)]
toList Empty = []
toList (Pair x y z) = (x,y):(toList z)
fromList :: [(k,v)] -> KeyVals k v
fromList [] = Empty
fromList ((x,y):xs) = Pair x y (fromList xs)
------------------------------------------------------------------------------
-- Ex 11: The data type Nat is the so called Peano
-- representation for natural numbers. Define functions fromNat and
-- toNat that convert natural numbers to Ints and vice versa.
--
-- Examples:
-- fromNat (PlusOne (PlusOne (PlusOne Zero))) ==> 3
-- toNat 3 ==> Just (PlusOne (PlusOne (PlusOne Zero)))
-- toNat (-3) ==> Nothing
--
data Nat = Zero | PlusOne Nat
deriving (Show,Eq)
fromNat :: Nat -> Int
fromNat Zero = 0
fromNat (PlusOne x) = 1 + fromNat x
toNat :: Int -> Maybe Nat
toNat 0 = Just Zero
toNat x
| x < 0 = Nothing
| otherwise = case toNat (x-1) of
(Just z) -> Just $ PlusOne z
------------------------------------------------------------------------------
-- Ex 12: While pleasingly simple in its definition, the Nat datatype is not
-- very efficient computationally. Instead of the unary Peano natural numbers,
-- computers use binary numbers.
--
-- Binary numbers are like decimal numbers, except that binary numbers have
-- only two digits (called bits), 0 and 1. The table below gives some
-- examples:
--
-- decimal | binary
-- --------+-------
-- 0 | 0
-- 1 | 1
-- 2 | 10
-- 7 | 111
-- 44 | 101100
--
-- For allowing arbitrarily long binary numbers, our representation, the
-- datatype Bin, includes a special End constructor for denoting the end of
-- the binary number. In order to make computation with Bin easier, the bits
-- are represented in increasing order by significance (i.e. "backwards").
-- Consider the Bin numbers O (I (I End)), representing 110 in binary or
-- 6 in decimal, and I (I (O End)) that represents 011 in binary or 3 in
-- decimal. The most significant (last) bit, the bit I, of O (I (I End)) is
-- greater than the bit O, which is the most significant bit of I (I (O End)).
-- Therefore, O (I (I End)) is greater than I (I (O End)).
--
-- Your task is to write functions prettyPrint, fromBin, and toBin that
-- convert Bin to human-readable string, Bin to Int, and Int to Bin
-- respectively.
--
-- Examples:
-- prettyPrint End ==> ""
-- prettyPrint (O End) ==> "0"
-- prettyPrint (I End) ==> "1"
-- prettyPrint (O (O (I (O (I End))))) ==> "10100"
-- map fromBin [O End, I End, O (I End), I (I End), O (O (I End)),
-- I (O (I End))]
-- ==> [0, 1, 2, 3, 4, 5]
-- fromBin (I (I (O (O (I (O (I (O End)))))))) ==> 83
-- fromBin (I (I (O (O (I (O (I End))))))) ==> 83
-- map toBin [0..5] ==>
-- [O End,I End,O (I End),I (I End),O (O (I End)),I (O (I End))]
-- toBin 57 ==> I (O (O (I (I (I End)))))
--
-- Challenge: Can you implement toBin by directly converting its input into a
-- sequence of bits instead of repeatedly applying inc?
--
data Bin = End | O Bin | I Bin
deriving (Show, Eq)
-- This function increments a binary number by one.
inc :: Bin -> Bin
inc End = I End
inc (O b) = I b
inc (I b) = O (inc b)
prettyPrint :: Bin -> String
prettyPrint z = case z of
End -> ""
O x -> (prettyPrint x)++"0"
I x -> (prettyPrint x)++"1"
fromBin :: Bin -> Int
fromBin z = hlp 0 z
where
hlp acc z = case z of
End -> 0
O x -> hlp (acc+1) x
I x -> 2^acc + hlp (acc+1) x
toBinH :: Int -> Bin
toBinH z
| d == 0 && r == 0 = End
| d > 0 && r == 0 = O (toBinH d)
| d >= 0 && r == 1 = I (toBinH d)
where d = div z 2 ; r = mod z 2
toBin :: Int -> Bin
toBin x = if x == 0 then O End else toBinH x 8 Binary tree
-- Exercise set 5b: playing with binary trees
-- The next exercises use the binary tree type defined like this:
data Tree a = Empty | Node a (Tree a) (Tree a)
deriving (Show, Eq)
------------------------------------------------------------------------------
-- Ex 1: implement the function valAtRoot which returns the value at
-- the root (top-most node) of the tree. The return value is Maybe a
-- because the tree might be empty (i.e. just a Empty)
valAtRoot :: Tree a -> Maybe a
valAtRoot Empty = Nothing
valAtRoot (Node x y z) = Just x
------------------------------------------------------------------------------
-- Ex 2: compute the size of a tree, that is, the number of Node
-- constructors in it
--
-- Examples:
-- treeSize (Node 3 (Node 7 Empty Empty) Empty) ==> 2
-- treeSize (Node 3 (Node 7 Empty Empty) (Node 1 Empty Empty)) ==> 3
treeSize :: Tree a -> Int
treeSize Empty = 0
treeSize (Node p q r) = 1 + treeSize q + treeSize r
------------------------------------------------------------------------------
-- Ex 3: get the largest value in a tree of positive Ints. The
-- largest value of an empty tree should be 0.
--
-- Examples:
-- treeMax Empty ==> 0
-- treeMax (Node 3 (Node 5 Empty Empty) (Node 4 Empty Empty)) ==> 5
treeMax :: Tree Int -> Int
treeMax Empty = 0
treeMax (Node p q r) = maximum [p, treeMax q, treeMax r]
------------------------------------------------------------------------------
-- Ex 4: implement a function that checks if all tree values satisfy a
-- condition.
--
-- Examples:
-- allValues (>0) Empty ==> True
-- allValues (>0) (Node 1 Empty (Node 2 Empty Empty)) ==> True
-- allValues (>0) (Node 1 Empty (Node 0 Empty Empty)) ==> False
allValues :: (a -> Bool) -> Tree a -> Bool
allValues cond Empty = True
allValues cond (Node p q r) = cond p && allValues cond q && allValues cond r
------------------------------------------------------------------------------
-- Ex 5: implement map for trees.
--
-- Examples:
--
-- mapTree (+1) Empty ==> Empty
-- mapTree (+2) (Node 0 (Node 1 Empty Empty) (Node 2 Empty Empty))
-- ==> (Node 2 (Node 3 Empty Empty) (Node 4 Empty Empty))
mapTree :: (a -> b) -> Tree a -> Tree b
mapTree f Empty = Empty
mapTree f (Node p q r) = Node (f p) (mapTree f q) (mapTree f r)
------------------------------------------------------------------------------
-- Ex 6: given a value and a tree, build a new tree that is the same,
-- except all nodes that contain the value have been removed. Also
-- remove the subnodes of the removed nodes.
--
-- Examples:
--
-- 1 1
-- / \ ==> \
-- 2 0 0
--
-- cull 2 (Node 1 (Node 2 Empty Empty)
-- (Node 0 Empty Empty))
-- ==> (Node 1 Empty
-- (Node 0 Empty Empty))
--
-- 1 1
-- / \ \
-- 2 0 ==> 0
-- / \
-- 3 4
--
-- cull 2 (Node 1 (Node 2 (Node 3 Empty Empty)
-- (Node 4 Empty Empty))
-- (Node 0 Empty Empty))
-- ==> (Node 1 Empty
-- (Node 0 Empty Empty)
--
-- 1 1
-- / \ \
-- 0 3 ==> 3
-- \ \
-- 2 0
--
-- cull 0 (Node 1 (Node 0 Empty
-- (Node 2 Empty Empty))
-- (Node 3 Empty
-- (Node 0 Empty Empty)))
-- ==> (Node 1 Empty
-- (Node 3 Empty Empty))
cull :: Eq a => a -> Tree a -> Tree a
cull val Empty = Empty
cull val (Node p q r)
| p == val = Empty
| otherwise = (Node p (cull val q) (cull val r))
------------------------------------------------------------------------------
-- Ex 7: check if a tree is ordered. A tree is ordered if:
-- * all values to the left of the root are smaller than the root value
-- * all of the values to the right of the root are larger than the root value
-- * and the left and right subtrees are ordered.
--
-- Hint: allValues will help you here!
--
-- Examples:
-- 1
-- / \ is ordered:
-- 0 2
-- isOrdered (Node 1 (Node 0 Empty Empty)
-- (Node 2 Empty Empty)) ==> True
--
-- 1
-- / \ is not ordered:
-- 2 3
-- isOrdered (Node 1 (Node 2 Empty Empty)
-- (Node 3 Empty Empty)) ==> False
--
-- 2
-- / \
-- 1 3 is not ordered:
-- \
-- 0
-- isOrdered (Node 2 (Node 1 Empty
-- (Node 0 Empty Empty))
-- (Node 3 Empty Empty)) ==> False
--
-- 2
-- / \
-- 0 3 is ordered:
-- \
-- 1
-- isOrdered (Node 2 (Node 0 Empty
-- (Node 1 Empty Empty))
-- (Node 3 Empty Empty)) ==> True
isOrdered :: Ord a => Tree a -> Bool
isOrdered Empty = True
isOrdered (Node x y z)= allValues (<x) y && allValues (>x) z && isOrdered y && isOrdered z
------------------------------------------------------------------------------
-- Ex 8: a path in a tree can be represented as a list of steps that
-- go either left or right.
data Step = StepL | StepR
deriving (Show, Eq)
-- Define a function walk that takes a tree and a list of steps, and
-- returns the value at that point. Return Nothing if you fall of the
-- tree (i.e. hit a Empty).
--
-- Examples:
-- walk [] (Node 1 (Node 2 Empty Empty) Empty) ==> Just 1
-- walk [StepL] (Node 1 (Node 2 Empty Empty) Empty) ==> Just 2
-- walk [StepL,StepL] (Node 1 (Node 2 Empty Empty) Empty) ==> Nothing
walk :: [Step] -> Tree a -> Maybe a
walk x Empty = Nothing
walk [] (Node p q r) = Just p
walk (x:xs) (Node p q r) = case x of
StepL -> walk xs q
StepR -> walk xs r
------------------------------------------------------------------------------
-- Ex 9: given a tree, a path and a value, set the value at the end of
-- the path to the given value. Since Haskell datastructures are
-- immutable, you'll need to build a new tree.
--
-- If the path falls off the tree, do nothing.
--
-- Examples:
-- set [] 1 (Node 0 Empty Empty) ==> (Node 1 Empty Empty)
-- set [StepL,StepL] 1 (Node 0 (Node 0 (Node 0 Empty Empty)
-- (Node 0 Empty Empty))
-- (Node 0 Empty Empty))
-- ==> (Node 0 (Node 0 (Node 1 Empty Empty)
-- (Node 0 Empty Empty))
-- (Node 0 Empty Empty))
--
-- set [StepL,StepR] 1 (Node 0 Empty Empty) ==> (Node 0 Empty Empty)
set :: [Step] -> a -> Tree a -> Tree a
set x val Empty = Empty
set (x:xs) val (Node p q r) = case x of
StepL -> Node p (set xs val q) r
StepR -> Node p q (set xs val r)
set [] val (Node p q r) = Node val q r
------------------------------------------------------------------------------
-- Ex 10: given a value and a tree, return a path that goes from the
-- root to the value. If the value doesn't exist in the tree, return Nothing.
--
-- If the value occurs in the tree multiple times, prefer the leftmost occurrence.
--
-- Examples:
-- search 1 (Node 2 (Node 1 Empty Empty) (Node 3 Empty Empty)) ==> Just [StepL]
-- search 1 (Node 2 (Node 4 Empty Empty) (Node 3 Empty Empty)) ==> Nothing
-- search 1 (Node 2 (Node 1 Empty Empty) (Node 1 Empty Empty)) ==> Just [StepL]
-- search 1 (Node 2 (Node 3 (Node 4 Empty Empty)
-- (Node 1 Empty Empty))
-- (Node 5 Empty Empty)) ==> Just [StepL,StepR]
search :: Eq a => a -> Tree a -> Maybe [Step]
search x Empty = Nothing
search x (Node p q r)
| x == p = Just []
| x /= p = case (search x q) of Just z -> Just (StepL:z)
Nothing -> case (search x r) of Just v -> Just (StepR:v)
Nothing -> Nothing 9 TypeClass instances
-- Exercise set 6: defining classes and instances
import Data.Char (toLower)
------------------------------------------------------------------------------
-- Ex 1: define an Eq instance for the type Country below. You'll need
-- to use pattern matching.
data Country = Finland | Switzerland | Norway
deriving Show
instance Eq Country where
(==) Finland Finland = True
(==) Switzerland Switzerland = True
(==) Norway Norway = True
(==) _ _ = False
------------------------------------------------------------------------------
-- Ex 2: implement an Ord instance for Country so that
-- Finland <= Norway <= Switzerland
--
-- Remember minimal complete definitions!
instance Ord Country where
--compare = todo -- implement me?
(<=) Finland Norway = True -- and me?
(<=) Norway Switzerland = True
(<=) Finland Switzerland = True
(<=) x y = x == y
min x y | x <= y = x
| otherwise = y
-- and me?
max x y | x <= y = y -- and me?
| otherwise = x
------------------------------------------------------------------------------
-- Ex 3: Implement an Eq instance for the type Name which contains a String.
-- The Eq instance should ignore capitalization.
--
-- Hint: use the function Data.Char.toLower that has been imported for you.
--
-- Examples:
-- Name "Pekka" == Name "pekka" ==> True
-- Name "Pekka!" == Name "pekka" ==> False
data Name = Name String
deriving Show
instance Eq Name where
(==) (Name x) (Name y) = fmap Data.Char.toLower x == fmap Data.Char.toLower y
------------------------------------------------------------------------------
-- Ex 4: here is a list type parameterized over the type it contains.
-- Implement an instance "Eq (List a)" that compares the lists element
-- by element.
--
-- Note how the instance needs an Eq a constraint. What happens if you
-- remove it?
data List a = Empty | LNode a (List a)
deriving Show
instance Eq a => Eq (List a) where
(==) Empty Empty = True
(==) x Empty = False
(==) Empty x = False
(==) (LNode x y) (LNode p q)= x == p && ((==) y q)
------------------------------------------------------------------------------
-- Ex 5: below you'll find two datatypes, Egg and Milk. Implement a
-- type class Price, containing a function price. The price function
-- should return an Int representing the price of the item in a store.
--
-- The prices should be as follows:
-- * chicken eggs cost 20
-- * chocolate eggs cost 30
-- * milk costs 15 per liter
data Egg = ChickenEgg | ChocolateEgg
deriving Show
data Milk = Milk Int -- amount in litres
deriving Show
class Price a where
price :: a -> Int
instance Price Egg where
price ChickenEgg = 20
price ChocolateEgg = 30
instance Price Milk where
price (Milk x) = x * 15
------------------------------------------------------------------------------
-- Ex 6: define the necessary instances in order to be able to compute these:
--
-- price [Just (ChocolateEgg), Nothing, Just (ChickenEgg)] ==> 50
-- price [Nothing, Nothing, Just (Milk 1), Just (Milk 2)] ==> 45
instance Price a => Price (Maybe a) where
price Nothing = 0
price (Just x) = price x
instance Price a => Price [a] where
price [] = 0
price (x:xs) = price x + price xs
------------------------------------------------------------------------------
-- Ex 7: below you'll find the datatype Number, which is either an
-- Integer, or a special value Infinite.
--
-- Implement an Ord instance so that finite Numbers compare normally,
-- and Infinite is greater than any other value.
data Number = Finite Integer | Infinite
deriving (Show,Eq)
instance Ord Number where
Infinite <= Infinite = True
Infinite <= _ = False
_ <= Infinite = True
(<=) (Finite x) (Finite y) = x <= y
------------------------------------------------------------------------------
-- Ex 8: rational numbers have a numerator and a denominator that are
-- integers, usually separated by a horizontal bar or a slash:
--
-- numerator
-- ------------- == numerator / denominator
-- denominator
--
-- You may remember from school that two rationals a/b and c/d are
-- equal when a*d == b*c. Implement the Eq instance for rationals
-- using this definition.
--
-- You may assume in all exercises that the denominator is always
-- positive and nonzero.
--
-- Examples:
-- RationalNumber 4 5 == RationalNumber 4 5 ==> True
-- RationalNumber 12 15 == RationalNumber 4 5 ==> True
-- RationalNumber 13 15 == RationalNumber 4 5 ==> False
data RationalNumber = RationalNumber Integer Integer
deriving Show
instance Eq RationalNumber where
RationalNumber a b == RationalNumber c d = a * d == b * c
------------------------------------------------------------------------------
-- Ex 9: implement the function simplify, which simplifies rational a
-- number by removing common factors of the numerator and denominator.
-- In other words,
--
-- ca a
-- ---- ==> ---
-- cb b
--
-- As a concrete example,
--
-- 12 3 * 4 4
-- ---- == ------- ==> ---.
-- 15 3 * 5 5
--
-- Hint: Remember the function gcd?
simplify :: RationalNumber -> RationalNumber
simplify (RationalNumber a b) = RationalNumber (div a (gcd a b)) (div b (gcd a b))
------------------------------------------------------------------------------
-- Ex 10: implement the typeclass Num for RationalNumber. The results
-- of addition and multiplication must be simplified.
--
-- Reminders:
-- * negate x is 0-x
-- * abs is absolute value
-- * signum is -1, +1 or 0 depending on the sign of the input
--
-- Examples:
-- RationalNumber 1 3 + RationalNumber 1 6 ==> RationalNumber 1 2
-- RationalNumber 1 3 * RationalNumber 3 1 ==> RationalNumber 1 1
-- negate (RationalNumber 2 3) ==> RationalNumber (-2) 3
-- fromInteger 17 :: RationalNumber ==> RationalNumber 17 1
-- abs (RationalNumber (-3) 2) ==> RationalNumber 3 2
-- signum (RationalNumber (-3) 2) ==> RationalNumber (-1) 1
-- signum (RationalNumber 0 2) ==> RationalNumber 0 1
instance Num RationalNumber where
(RationalNumber a b) + (RationalNumber c d) = simplify (RationalNumber (a*d + b*c) (b*d))
(RationalNumber a b) * (RationalNumber c d) = simplify (RationalNumber (a*c) (b*d))
abs (RationalNumber a b) = RationalNumber (abs a) (abs b)
signum (RationalNumber a b) | a == 0 = 0
| a * b > 0 = 1
| otherwise = -1
fromInteger x = RationalNumber x 1
negate (RationalNumber a b) = (RationalNumber (-a) b)
------------------------------------------------------------------------------
-- Ex 11: a class for adding things. Define a class Addable with a
-- constant `zero` and a function `add`. Define instances of Addable
-- for Integers and lists. Numbers are added with the usual addition,
-- while lists are added by catenating them. Pick a value for `zero`
-- such that: `add zero x == x`
--
-- Examples:
-- add 1 2 ==> 3
-- add 1 zero ==> 1
-- add [1,2] [3,4] ==> [1,2,3,4]
-- add zero [True,False] ==> [True,False]
class Addable a where
zero :: a
add :: a -> a -> a
instance Addable Integer where
zero = 0
add x y = x + y
instance Addable [a] where
zero = []
add x y = x ++ y
------------------------------------------------------------------------------
-- Ex 12: cycling. Implement a type class Cycle that contains a
-- function `step` that cycles through the values of the type.
-- Implement instances for Color and Suit that work like this:
--
-- step Red ==> Green
-- step Green ==> Blue
-- step Blue ==> Red
--
-- The suit instance should cycle suits in the order Club, Spade,
-- Diamond, Heart, Club.
--
-- Also add a function `stepMany` and give it a default implementation
-- using `step`. The function `stepMany` should take multiple
-- (determined by an Int argument) steps like this:
--
-- stepMany 2 Club ==> Diamond
-- stepMany 3 Diamond ==> Spade
data Color = Red | Green | Blue
deriving (Show, Eq)
data Suit = Club | Spade | Diamond | Heart
deriving (Show, Eq)
class Cycle a where
step :: a -> a
stepMany :: Int -> a -> a
stepMany 0 x = x
stepMany n x = stepMany (n-1) (step x)
instance Cycle Color where
step Red = Green
step Green = Blue
step Blue = Red
instance Cycle Suit where
step Club = Spade
step Spade = Diamond
step Diamond = Heart
step Heart = Club
--We can think of class as an interface in C# or Java
--Semigroup is an interface describing implementation of a mathematical Semigroup
--class Semigroup a where
-- An associative operation.
-- (<>) :: a -> a -> a
--Monoid is an interface that extends the Semigroup interface by including identity element
-- class Semigroup a => Monoid a where
-- -- The identity element
-- mempty :: a
--list is a Semigroup
--try below and it will output [1,2,3,4]
--[1] <> [2,3] <> [4]
-- data Sum a = Sum a
-- instance Num a => Semigroup (Sum a) where
-- Sum a <> Sum b = Sum (a+b)
