├── README.md ├── ch-02 ├── 1.md ├── 4.hs ├── 3.hs └── 5.hs ├── ch-04 ├── 6.hs ├── 5.hs ├── 4.hs ├── 1.hs ├── 3.hs └── 2.hs ├── ch-07 ├── 3.hs ├── 5.md ├── 1.hs ├── 4.hs ├── 7.hs ├── 6.hs ├── 2.hs ├── BinaryNumbers.hs └── 8.hs ├── ch-05 ├── 1.hs ├── 6.hs ├── 2.hs ├── 5.hs ├── 4.hs ├── 7.hs ├── 3.hs └── 8.hs ├── ch-01 ├── 2.md ├── 3.hs ├── 1.md ├── 5.hs └── 4.hs ├── ch-03 ├── 1.md ├── 2.hs └── 4.md └── ch-06 ├── 1.hs ├── 4.hs ├── 2.hs ├── 6.hs ├── 3.hs └── 5.hs /README.md: -------------------------------------------------------------------------------- 1 | programming-in-haskell 2 | ====================== 3 | 4 | Exercises of Programming in Haskell book 5 | -------------------------------------------------------------------------------- /ch-02/1.md: -------------------------------------------------------------------------------- 1 | # Parenthesise the following arithmetic expressions 2 | 3 | ``` 4 | (2 ^ 3) * 4 5 | (2 * 3) + (4 * 5) 6 | 2 + (3 * (4 ^ 5)) 7 | ``` 8 | -------------------------------------------------------------------------------- /ch-04/6.hs: -------------------------------------------------------------------------------- 1 | -- Show how the curried function definition mult x y z = x ∗y ∗z can be 2 | -- understood in terms of lambda expressions. 3 | 4 | mult = \x -> \y -> \z -> x * y * z 5 | -------------------------------------------------------------------------------- /ch-07/3.hs: -------------------------------------------------------------------------------- 1 | -- | Redefine the functions map f and filter p using foldr . 2 | 3 | map' f xs = foldr (\x xs -> f x : xs) [] 4 | 5 | filter' p xs = foldr (\x xs -> if p xs then x:xs else xs) [] 6 | -------------------------------------------------------------------------------- /ch-05/1.hs: -------------------------------------------------------------------------------- 1 | -- Using a list comprehension, give an expression that calculates 2 | -- the sum 1² + 2² + . . . 100² of the first one hundred integer squares. 3 | 4 | firstHundredSquared = [x ^ 2 | x <- [1..100]] 5 | -------------------------------------------------------------------------------- /ch-07/5.md: -------------------------------------------------------------------------------- 1 | It is invalid because in order to compose functions you have to provide 2 | two functions. In this example it is trying to combine a function with a List. 3 | 4 | Also it is trying to combine functions with different types. 5 | -------------------------------------------------------------------------------- /ch-07/1.hs: -------------------------------------------------------------------------------- 1 | -- Show how the list comprehension [ f x | x ← xs , p x ] can be re-expressed 2 | -- using the higher-order functions map and filter. 3 | 4 | func :: (a -> b) -> (a -> Bool) -> [a] -> [b] 5 | func f p xs = map f(filter p xs) 6 | -------------------------------------------------------------------------------- /ch-07/4.hs: -------------------------------------------------------------------------------- 1 | -- | Using foldl, define a function dec2int::[Int] → Int that converts a decimal 2 | -- | number into an integer. For example: 3 | -- | dec2int [2,3,4,5] -> 2345 4 | 5 | dec2int :: [Int] -> Int 6 | dec2int = foldl (\x y -> 10 * x + y) 0 7 | -------------------------------------------------------------------------------- /ch-04/5.hs: -------------------------------------------------------------------------------- 1 | -- Do the same for the following version, and note the difference in the number 2 | -- of conditional expressions required: 3 | 4 | -- True ∧ b = b 5 | -- False ∧ _ = False 6 | 7 | (∧) :: Bool -> Bool -> Bool 8 | a ∧ b = if a then b else False 9 | -------------------------------------------------------------------------------- /ch-01/2.md: -------------------------------------------------------------------------------- 1 | # Show that sum [x] = x for any number x. 2 | 3 | ``` 4 | sum [] = 0 5 | sum (x:xs) = x + sum xs 6 | ``` 7 | 8 | ``` 9 | sum [x] 10 | = { applying sum } 11 | x + sum[] 12 | = { applying sum } 13 | x + 0 14 | = { applying + } 15 | x 16 | ``` 17 | -------------------------------------------------------------------------------- /ch-03/1.md: -------------------------------------------------------------------------------- 1 | # What are the types of the following values? 2 | 3 | ``` 4 | ['a', 'b', 'c'] :: [Char] 5 | ('a', 'b', 'c') :: (Char, Char, Char) 6 | [(False, 'O'), (True, '1')] :: [(Bool, Char)] 7 | ([False, True], ['0', '1']) :: ([Bool], [Char]) 8 | [tail, init, reverse] :: [[a] -> [a]] 9 | ``` 10 | -------------------------------------------------------------------------------- /ch-05/6.hs: -------------------------------------------------------------------------------- 1 | -- Redefine the function positions using the function find. 2 | 3 | positions :: Eq a => a -> [a] -> [Int] 4 | positions x xs = find x (zip xs [0..n]) 5 | where n = length xs - 1 6 | 7 | find :: Eq a => a -> [(a, b)] -> [b] 8 | find k t = [v | (k', v) <- t, k == k'] 9 | -------------------------------------------------------------------------------- /ch-04/4.hs: -------------------------------------------------------------------------------- 1 | -- Redefine the following version of the conjunction operator using conditional 2 | -- expressions rather than pattern matching: 3 | 4 | -- True ∧ True = True 5 | -- _ ∧ _ = False 6 | 7 | (∧) :: Bool -> Bool -> Bool 8 | a ∧ b = if a then 9 | if b then True else False 10 | else 11 | False 12 | -------------------------------------------------------------------------------- /ch-04/1.hs: -------------------------------------------------------------------------------- 1 | -- Using library functions, define a function halve :: [ a ] → ([ a ], [ a ]) that splits an even-lengthed list into two halves. 2 | -- For example: 3 | -- > halve [1,2,3,4,5,6] 4 | -- ([1, 2, 3], [4, 5, 6]) 5 | 6 | halve :: [a] -> ([a], [a]) 7 | halve xs = splitAt halfSize xs 8 | where halfSize = length xs `div` 2 9 | -------------------------------------------------------------------------------- /ch-06/1.hs: -------------------------------------------------------------------------------- 1 | -- Define the exponentiation operator ↑ for non-negative integers using the same pattern of recursion as the multiplication operator ∗, and show how 2 ↑ 3 is evaluated using your definition. 2 | 3 | power :: Int -> Int -> Int 4 | power base 0 = 1 5 | power base 1 = base 6 | power base exponential = base * (power base (exponential - 1)) 7 | -------------------------------------------------------------------------------- /ch-05/2.hs: -------------------------------------------------------------------------------- 1 | -- In a similar way to the function length, show how the library function 2 | -- replicate :: Int → a → [ a ] that produces a list of identical elements can 3 | -- be defined using a list comprehension. For example: 4 | 5 | -- > replicate 3 True 6 | -- [True, True, True ] 7 | 8 | replicate' :: Int -> b -> [b] 9 | replicate' a b = [b | _ <- [1..a]] 10 | -------------------------------------------------------------------------------- /ch-07/7.hs: -------------------------------------------------------------------------------- 1 | type Bit = Int 2 | 3 | unfold p h t x 4 | | p x = [] 5 | | otherwise = h x : unfold p h t (t x) 6 | 7 | chop8' :: [Bit] -> [[Bit]] 8 | chop8' = unfold null (take 8) (drop 8) 9 | 10 | map' :: (a -> b) -> [a] -> [b] 11 | map' f = unfold null (f . head) tail 12 | 13 | iterate' :: (a -> a) -> a -> [a] 14 | iterate' f = unfold (const False) id f 15 | -------------------------------------------------------------------------------- /ch-05/5.hs: -------------------------------------------------------------------------------- 1 | -- Show how the single comprehension [(x,y) | x ← [1,2,3], y ← [4,5,6]] with two 2 | -- generators can be re-expressed using two comprehensions with single generators. 3 | -- Hint: make use of the library function concat and nest one comprehension within the other. 4 | 5 | combinations :: [(Int, Int)] 6 | combinations = concat [[(x, y) | x <- [1, 2, 3]] | y <- [4, 5, 6]] 7 | -------------------------------------------------------------------------------- /ch-01/3.hs: -------------------------------------------------------------------------------- 1 | -- To execute this file, just run: runhaskell 3.hs 2 | 3 | -- Define a function product that produces the product of a list of numbers, 4 | -- and show using your definition that product [ 2, 3, 4 ] = 24. 5 | 6 | prod :: Num a => [a] -> a 7 | prod [] = 1 8 | prod (x:xs) = x * prod xs 9 | 10 | main :: IO() 11 | main = do 12 | putStrLn . show $ prod [2, 3, 4] 13 | -- 24 14 | -------------------------------------------------------------------------------- /ch-06/4.hs: -------------------------------------------------------------------------------- 1 | -- Define a recursive function merge :: Ord a ⇒ [a] → [a] → [a] that merges two 2 | -- sorted lists to give a single sorted list. For example: 3 | 4 | -- merge [2,5,6] [1,3,4] 5 | -- [1,2,3,4,5,6] 6 | 7 | merge :: Ord a => [a] -> [a] -> [a] 8 | merge x [] = x 9 | merge [] y = y 10 | merge (x:xs) (y:ys) | x <= y = x:merge xs (y:ys) 11 | | otherwise = y:merge (x:xs) ys 12 | -------------------------------------------------------------------------------- /ch-01/1.md: -------------------------------------------------------------------------------- 1 | # Give another possible calculation for the result of double (double 2). 2 | 3 | ``` 4 | double (double 2) 5 | = { applying the outer double } 6 | double 2 + double 2 7 | = { applying the first double } 8 | (2 + 2) + double 2 9 | = { applying the last double } 10 | (2 + 2) + (2 + 2) 11 | = { applying the first + } 12 | 4 + (2 + 2) 13 | = { applying the last + } 14 | 4 + 4 15 | = { applying + } 16 | 8 17 | ``` 18 | -------------------------------------------------------------------------------- /ch-03/2.hs: -------------------------------------------------------------------------------- 1 | -- What are the types of the following functions? 2 | 3 | second :: [a] -> a 4 | second xs = head (tail xs) 5 | 6 | swap :: (a, b) -> (b, a) 7 | swap (x, y) = (y, x) 8 | 9 | pair :: a -> b -> (a, b) 10 | pair x y = (x, y) 11 | 12 | double :: Num a => a -> a 13 | double x = x * 2 14 | 15 | palindrome :: Eq a => [a] -> Bool 16 | palindrome xs = reverse xs == xs 17 | 18 | twice :: (a -> a) -> a -> a 19 | twice f x = f(f x) 20 | -------------------------------------------------------------------------------- /ch-02/4.hs: -------------------------------------------------------------------------------- 1 | -- Show how the library function last that selects the last element of a non- 2 | -- empty list could be defined in terms of the library functions introduced in 3 | -- this chapter. Can you think of another possible definition? 4 | 5 | anotherLastImplementation :: Num a => [a] -> a 6 | anotherLastImplementation (x) = head (reverse x) 7 | 8 | main :: IO() 9 | main = do 10 | putStrLn . show $ anotherLastImplementation [1, 2, 3, 4, 5, 6] 11 | -- 6 12 | -------------------------------------------------------------------------------- /ch-05/4.hs: -------------------------------------------------------------------------------- 1 | -- A positive integer is perfect if it equals the sum of its factors, excluding 2 | -- the number itself. Using a list comprehension and the function factors, define 3 | -- a function perfects :: Int → [Int] that returns the list of all perfect numbers 4 | -- up to a given limit. For example: 5 | 6 | -- > perfects 500 7 | -- [6, 28, 496] 8 | 9 | perfects :: Int -> [Int] 10 | perfects a = [x | x <- [1..a], sum(init (factors x)) == x] 11 | 12 | factors :: Int -> [Int] 13 | factors a = [x | x <- [1..a], a `mod` x == 0] 14 | -------------------------------------------------------------------------------- /ch-07/6.hs: -------------------------------------------------------------------------------- 1 | -- | Without looking at the standard prelude, define the higher-order library 2 | -- | function curry that converts a function on pairs into a curried function, and, 3 | -- | conversely, the function uncurry that converts a curried function with two 4 | -- | arguments into a function on pairs. 5 | 6 | -- | Hint: first write down the types of the two functions. 7 | 8 | curry' :: ((a, b) -> c) -> a -> b -> c 9 | curry' f = \x y -> f(x, y) 10 | 11 | uncurry' :: (a -> b -> c) -> (a, b) -> c 12 | uncurry' f = \(x, y) -> f x y 13 | -------------------------------------------------------------------------------- /ch-05/7.hs: -------------------------------------------------------------------------------- 1 | -- The scalar product of two lists of integers xs and ys of length n is given by 2 | -- the sum of the products of corresponding integers: 3 | 4 | -- In a similar manner to the function chisqr, show how a list comprehension can 5 | -- be used to define a function scalarproduct :: [Int] → [Int] → Int that returns 6 | -- the scalar product of two lists. For example: 7 | 8 | -- > scalarproduct [1, 2, 3] [4, 5, 6] 9 | -- 32 10 | 11 | scalarproduct :: [Int] -> [Int] -> Int 12 | scalarproduct xs ys = sum [k * v | (k, v) <- zip xs ys] 13 | -------------------------------------------------------------------------------- /ch-02/3.hs: -------------------------------------------------------------------------------- 1 | -- The script below contains three syntactic errors. Correct these errors and 2 | -- then check that your script works properly using Hugs. 3 | -- N = a ’div’ length xs 4 | -- where 5 | -- a = 10 6 | -- xs = [1,2,3,4,5] 7 | 8 | -- 1: The name should start with a lower case. 9 | -- 2: The indentation of `xs` is wrong. 10 | -- 3: It should be backticks -> ` 11 | 12 | n = a `div` (length xs) 13 | where 14 | a = 10 15 | xs = [1, 2, 3, 4, 5] 16 | 17 | main :: IO() 18 | main = do 19 | putStrLn . show $ n 20 | -- 2 21 | -------------------------------------------------------------------------------- /ch-04/3.hs: -------------------------------------------------------------------------------- 1 | -- In a similar way to ∧, show how the logical disjunction operator ∨ 2 | -- can be defined in four different ways using pattern matching. 3 | 4 | (∨) :: Bool -> Bool -> Bool 5 | True ∨ False = True 6 | True ∨ True = True 7 | False ∨ False = False 8 | False ∨ True = True 9 | 10 | (∨∨) :: Bool -> Bool -> Bool 11 | False ∨∨ a = a 12 | _ ∨∨ _ = True 13 | 14 | (∨∨∨) :: Bool -> Bool -> Bool 15 | False ∨∨∨ False = False 16 | False ∨∨∨ True = True 17 | True ∨∨∨ _ = True 18 | 19 | (∨∨∨∨) :: Bool -> Bool -> Bool 20 | False ∨∨∨∨ False = False 21 | _ ∨∨∨∨ _ = True 22 | -------------------------------------------------------------------------------- /ch-01/5.hs: -------------------------------------------------------------------------------- 1 | -- To execute this file, just run: runhaskell 5.hs 2 | 3 | -- What would be the effect of replacing ≤ by < in the definition of qsort? 4 | -- R: It will produce a sorted list with uniq values. 5 | 6 | -- Quicksort 7 | uniqQsort :: Ord a => [a] -> [a] 8 | uniqQsort [] = [] 9 | uniqQsort (x:xs) = uniqQsort smaller ++ [x] ++ uniqQsort larger 10 | where 11 | smaller = [a | a <- xs, a < x] 12 | larger = [b | b <- xs, b > x] 13 | 14 | main :: IO() 15 | main = do 16 | putStrLn . show $ uniqQsort [3, 7, 4, 1, 1, 6, 4, 7, 4, 3] 17 | -- [1,3,4,6,7] 18 | -------------------------------------------------------------------------------- /ch-03/4.md: -------------------------------------------------------------------------------- 1 | ### Why is it not feasible in general for function types to be instances of the Eq class? When is it feasible? Hint: two functions of the same type are equal if they always return equal results for equal arguments. 2 | 3 | #### R: In order to check if two functions are equal, it is required enumerating all the possible arguments and checking the output for each value. This way it is practically impossible to check functions equality. 4 | 5 | #### R: It could be feasible when the number of possible arguments is a known number, such as functions that accepts Bool which only have two possible value. 6 | -------------------------------------------------------------------------------- /ch-02/5.hs: -------------------------------------------------------------------------------- 1 | -- Show how the library function init that removes the last element from a 2 | -- non-empty list could similarly be defined in two different ways. 3 | 4 | firstAlternativeInit :: Num a => [a] -> [a] 5 | firstAlternativeInit x = take (length x - 1) x 6 | 7 | secondAlternativeInit :: Num a => [a] -> [a] 8 | secondAlternativeInit x = reverse (tail (reverse x)) 9 | -- Ugly, right? 10 | 11 | main :: IO() 12 | main = do 13 | putStrLn . show $ firstAlternativeInit [1, 2, 3, 4, 5, 6] 14 | -- [1, 2, 3, 4, 5] 15 | 16 | putStrLn . show $ secondAlternativeInit [1, 2, 3, 4, 5, 6] 17 | -- [1, 2, 3, 4, 5] 18 | -------------------------------------------------------------------------------- /ch-05/3.hs: -------------------------------------------------------------------------------- 1 | -- A triple (x, y, z) of positive integers is pythagorean if x2 + y2 = z2. 2 | -- Using a list comprehension, define a function pyths :: Int → [(Int, Int, Int)] 3 | -- that returns the list of all pythagorean triples whose components are at most 4 | -- a given limit. For example: 5 | 6 | -- > pyths 10 7 | -- [(3, 4, 5), (4, 3, 5), (6, 8, 10), (8, 6, 10)] 8 | 9 | pyths :: Int -> [(Int, Int, Int)] 10 | pyths a = [(x, y, z) | (x, y, z) <- combinations a, x ^ 2 + y ^ 2 == z ^2] 11 | 12 | combinations :: Int -> [(Int, Int, Int)] 13 | combinations a = [(x, y, z) | x <- [1..a], y <- [1..a], z <- [1..a]] 14 | -------------------------------------------------------------------------------- /ch-06/2.hs: -------------------------------------------------------------------------------- 1 | -- Using the definitions given in this chapter, show how length [1,2,3], drop 3 [1, 2, 3, 4, 5], and init [1, 2, 3] are evaluated. 2 | 3 | length [1, 2, 3] 4 | -- applying length 5 | 1 + length [2, 3] 6 | -- applying length 7 | 1 + (1 + length [3]) 8 | -- applying length 9 | 1 + 1 + (1 + length []) 10 | -- applying length 11 | 1 + 1 + 1 + 0 12 | 13 | drop 3 [1, 2, 3, 4, 5] 14 | -- applying drop 15 | drop 2 [2, 3, 4, 5] 16 | -- applying drop 17 | drop 1 [3, 4, 5] 18 | -- applying drop 19 | drop 0 [4, 5] 20 | 21 | init [1, 2, 3] 22 | -- applying init 23 | 1:init[2, 3] 24 | -- applying init 25 | 1:2:init[3] 26 | --applying init 27 | 1:2:[] 28 | -------------------------------------------------------------------------------- /ch-07/2.hs: -------------------------------------------------------------------------------- 1 | -- | Without looking at the definitions from the standard prelude, define the 2 | -- | higher-order functions all, any, takeWhile, and dropWhile. 3 | 4 | all' :: (a -> Bool) -> [a] -> Bool 5 | all' p = and . map p 6 | 7 | any' :: (a -> Bool) -> [a] -> Bool 8 | any' p = or . map p 9 | 10 | takeWhile' :: (a -> Bool) -> [a] -> [a] 11 | takeWhile' p [] = [] 12 | takeWhile' p (x:xs) 13 | | p x = x : takeWhile' p xs 14 | | otherwise = [] 15 | 16 | dropWhile' :: (a -> Bool) -> [a] -> [a] 17 | dropWhile' _ [] = [] 18 | dropWhile' p (x:xs) 19 | | p x = dropWhile' p xs 20 | | otherwise = x : xs 21 | -------------------------------------------------------------------------------- /ch-04/2.hs: -------------------------------------------------------------------------------- 1 | -- Consider a function safetail :: [ a ] → [ a ] that behaves as the library func- 2 | -- tion tail, except that safetail maps the empty list to itself, whereas tail 3 | -- produces an error in this case. Define safetail using: 4 | 5 | -- (a) a conditional expression; 6 | -- (b) guarded equations; 7 | -- (c) pattern matching. 8 | -- Hint: make use of the library function null. 9 | 10 | safetail' :: [a] -> [a] 11 | safetail' xs = if null xs then xs else tail xs 12 | 13 | safetail'' :: [a] -> [a] 14 | safetail'' xs | null xs = xs 15 | | otherwise = tail xs 16 | 17 | safetail''' :: [a] -> [a] 18 | safetail''' [] = [] 19 | safetail''' (_:xs) = xs 20 | -------------------------------------------------------------------------------- /ch-06/6.hs: -------------------------------------------------------------------------------- 1 | -- Using the five-step process, define the library functions that 2 | -- calculate the sum of a list of numbers, take a given number of elements 3 | -- from the start of a list, and select the last element of a non-empty list. 4 | 5 | -- 1 - define the type 6 | -- 2 - enumerate the cases 7 | -- 3 - define the simple cases 8 | -- 4 - define the other cases 9 | -- 5 - generalise and simplify 10 | 11 | -- 1 12 | sum' :: [Int] -> Int 13 | -- 2 14 | sum' [] = 15 | sum' xs = 16 | -- 3 17 | sum' [] = 0 18 | sum' (x:xs) = 19 | -- 4 20 | sum' [] = 0 21 | sum' (x:xs) = x + sum xs 22 | -- 5 23 | sum' :: Num a => [a] -> a 24 | sum' [] = 0 25 | sum' (x:xs) = x + sum xs 26 | -------------------------------------------------------------------------------- /ch-06/3.hs: -------------------------------------------------------------------------------- 1 | -- Without looking at the definitions from the standard prelude, define the following library functions using recursion. 2 | 3 | and' :: [Bool] -> Bool 4 | and' [] = True 5 | and' (b:bs) = b && and' bs 6 | 7 | concat' :: [[a]] -> [a] 8 | concat' [] = [] 9 | concat' (x:xs) = x ++ concat' xs 10 | 11 | replicate' :: Int -> a -> [a] 12 | replicate' 0 _ = [] 13 | replicate' x a = [a] ++ replicate' (x - 1) a 14 | 15 | nth' :: [a] -> Int -> a 16 | nth' (a:_) 0 = a 17 | nth' (a:as) x = nth' as (x - 1) 18 | 19 | elem' :: Eq a => a -> [a] -> Bool 20 | elem' x [] = False 21 | elem' x (a:as) | x == a = True 22 | | otherwise = elem' x as 23 | -------------------------------------------------------------------------------- /ch-07/BinaryNumbers.hs: -------------------------------------------------------------------------------- 1 | -- | Convert a String into a List of zeros and ones. 2 | 3 | module BinaryNumbers where 4 | import Data.Char 5 | 6 | type Bit = Int 7 | 8 | bin2int :: [Bit] -> Int 9 | bin2int bits = foldr (\x y -> x + 2 * y) 0 bits 10 | 11 | int2bin :: Int -> [Bit] 12 | int2bin 0 = [] 13 | int2bin n = n `mod` 2 : int2bin (n `div` 2) 14 | 15 | make8 :: [Bit] -> [Bit] 16 | make8 bits = take 8 (bits ++ repeat 0) 17 | 18 | encode :: String -> [Bit] 19 | encode = concat . map (make8 . int2bin . ord) 20 | 21 | chop8 :: [Bit] -> [[Bit]] 22 | chop8 [] = [] 23 | chop8 bits = take 8 bits : chop8 (drop 8 bits) 24 | 25 | decode :: [Bit] -> String 26 | decode = map (chr . bin2int) . chop8 27 | 28 | transmit :: String -> String 29 | transmit = decode . channel . encode 30 | 31 | channel :: [Bit] -> [Bit] 32 | channel = id 33 | -------------------------------------------------------------------------------- /ch-06/5.hs: -------------------------------------------------------------------------------- 1 | -- Using merge, define a recursive function msort :: Ord a ⇒ [a] → [a] 2 | -- that implements merge sort, in which the empty list and singleton lists are 3 | -- already sorted, and any other list is sorted by merging together the two lists 4 | -- that result from sorting the two halves of the list separately. 5 | 6 | -- Hint: first define a function halve :: [a] → [([a], [a])] that splits a 7 | -- list into two halves whose lengths differ by at most one. 8 | 9 | msort :: Ord a => [a] -> [a] 10 | msort [] = [] 11 | msort [a] = [a] 12 | msort as = merge(msort start) (msort end) 13 | where (start, end) = halve as 14 | 15 | halve :: [a] -> ([a], [a]) 16 | halve xs = splitAt halfSize xs 17 | where halfSize = length xs `div` 2 18 | 19 | merge :: Ord a => [a] -> [a] -> [a] 20 | merge x [] = x 21 | merge [] y = y 22 | merge (x:xs) (y:ys) | x <= y = x:merge xs (y:ys) 23 | | otherwise = y:merge (x:xs) ys 24 | -------------------------------------------------------------------------------- /ch-01/4.hs: -------------------------------------------------------------------------------- 1 | -- To execute this file, just run: runhaskell 4.hs 2 | 3 | -- How should the definition of the function qsort be modified so that it 4 | -- produces a reverse sorted version of a list? 5 | 6 | -- Quicksort 7 | qsort :: Ord a => [a] -> [a] 8 | qsort [] = [] 9 | qsort (x:xs) = qsort smaller ++ [x] ++ qsort larger 10 | where 11 | smaller = [a | a <- xs, a <= x] 12 | larger = [b | b <- xs, b > x] 13 | 14 | -- To change the order, just swap the larger and smaller arrays. 15 | reverseQsort :: Ord a => [a] -> [a] 16 | reverseQsort [] = [] 17 | reverseQsort (x:xs) = reverseQsort larger ++ [x] ++ reverseQsort smaller 18 | where 19 | smaller = [a | a <- xs, a <= x] 20 | larger = [b | b <- xs, b > x] 21 | 22 | main :: IO() 23 | main = do 24 | putStrLn . show $ qsort [3, 7, 4, 1, 1, 6, 4, 7, 4, 3] 25 | -- [1,1,3,3,4,4,4,6,7,7] 26 | putStrLn . show $ reverseQsort [3, 7, 4, 1, 1, 6, 4, 7, 4, 3] 27 | -- [7,7,6,4,4,4,3,3,1,1] 28 | -------------------------------------------------------------------------------- /ch-05/8.hs: -------------------------------------------------------------------------------- 1 | -- Modify the Caesar cipher program to also handle upper-case letters. 2 | import Data.Char 3 | 4 | letLower2int :: Char -> Int 5 | letLower2int c = ord c - ord 'a' 6 | 7 | int2letLower :: Int -> Char 8 | int2letLower n = chr(ord 'a' + n) 9 | 10 | letUpper2int :: Char -> Int 11 | letUpper2int c = ord c - ord 'A' 12 | 13 | int2letUpper :: Int -> Char 14 | int2letUpper n = chr(ord 'A' + n) 15 | 16 | shift :: Int -> Char -> Char 17 | shift n c | isLower c = int2letLower((letLower2int c + n) `mod` 26) 18 | | isUpper c = int2letUpper((letUpper2int c + n) `mod` 26) 19 | | otherwise = c 20 | 21 | percent :: Int -> Int -> Float 22 | percent n m = (fromIntegral n / fromIntegral m) * 100 23 | 24 | count :: Char -> [Char] -> Int 25 | count c xs = sum [1 | x <- xs, x == c] 26 | 27 | encode :: Int -> String -> String 28 | encode n xs = [shift n x | x <- xs] 29 | 30 | letters :: [Char] -> Int 31 | letters xs = sum [1 | x <- xs, isLetter x] 32 | 33 | freqs :: String -> [Float] 34 | freqs xs = [percent (count x xs) n | x <- ['a'..'z']] 35 | where n = letters xs 36 | -------------------------------------------------------------------------------- /ch-07/8.hs: -------------------------------------------------------------------------------- 1 | import Data.Char 2 | 3 | type Bit = Int 4 | 5 | bin2int :: [Bit] -> Int 6 | bin2int bits = foldr (\x y -> x + 2 * y) 0 bits 7 | 8 | int2bin :: Int -> [Bit] 9 | int2bin 0 = [] 10 | int2bin n = n `mod` 2 : int2bin (n `div` 2) 11 | 12 | make8 :: [Bit] -> [Bit] 13 | make8 bits = take 8 (bits ++ repeat 0) 14 | 15 | chop8 :: [Bit] -> [[Bit]] 16 | chop8 [] = [] 17 | chop8 bits = take 8 bits : chop8 (drop 8 bits) 18 | 19 | transmit :: String -> String 20 | transmit = decode . channel . encode 21 | 22 | channel :: [Bit] -> [Bit] 23 | channel = id 24 | 25 | parity :: [Bit] -> Bit 26 | parity bits 27 | | odd(sum bits) = 1 28 | | otherwise = 0 29 | 30 | addParity :: [Bit] -> [Bit] 31 | addParity bits = (parity bits) : bits 32 | 33 | chop9 :: [Bit] -> [[Bit]] 34 | chop9 [] = [] 35 | chop9 bits = take 9 bits : chop9 (drop 9 bits) 36 | 37 | checkParity :: [Bit] -> [Bit] 38 | checkParity (b:bs) 39 | | b == parity bs = bs 40 | | otherwise = error "Invalid parity" 41 | 42 | encode :: String -> [Bit] 43 | encode = concat . map (addParity . make8 . int2bin . ord) 44 | 45 | decode :: [Bit] -> String 46 | decode = map (chr . bin2int . checkParity) . chop9 47 | --------------------------------------------------------------------------------