first chapters sample code

exercises.hs

-- 1.7Exercises
-- 1.Give another possible calculation for the result of double (double 2).
double x = x + x

another = (double . double) 2

-- 2.Show that sum [x] = x for any number x.
ex2 :: (Eq a, Num a) => a -> Bool
ex2 x = sum [x] == x

ex2Proof :: Bool
ex2Proof = all ex2 [1..1000]

-- 3.Define a function product that produces the product of
-- a list of numbers, and show using your definition that
-- product [2,3,4] = 24.
product' :: Num a => [a] -> a
product' []     = 1
product' (x:xs) = x * product' xs

product'' :: Num a => [a] -> a
product'' = foldr (*) 1

a = map (\p -> p [2,3,4]) [product, product', product'']

-- 4.How should the definition of the function qsort be modified so that
-- it produces a reverse sorted version of a list?
qsortR :: Ord a => [a] -> [a]
qsortR [] = []
qsortR (x:xs) = qsort larger ++ [x] ++ qsort smaller
               where
                   smaller = [ a | a <- xs, a <= x]
                   larger  = [ b | b <- xs, b  > x]
-- 5.What would be the effect of replacing <= by < in the original
-- definition of qsort? Hint: consider the example qsort [2,2,3,1,1].
qsort :: Ord a => [a] -> [a]
qsort [] = []
qsort (x:xs) = qsort smaller ++ [x] ++ qsort larger
               where
                   smaller = [ a | a <- xs, a < x]
                   larger  = [ b | b <- xs, b > x]

-- It'll remove duplicates, 
-- *Main> qsort [2,2,3,1,1]
-- [1,2,3]

--------------------------
-- 2.7Exercises
-- 1.Work through the examples from this chapter using GHCi.
-- DONE

-- 2.Parenthesise the following numeric expressions:
-- 2^3*4
-- 2*3+4*5 
-- 2+3*4^5

b = (2^3)*4
c = (2*3)+(4*5) 
d = 2+(3*(4^5))

-- *Main> 2^3*4 == b
-- True
-- *Main> 2*3+4*5 == c
-- True
-- *Main> 2+(3*(4^5)) == d
-- True

-- 3.The script below contains three syntactic errors.
-- Correct these errors and then check that your script works properly using GHCi.
-- N = a ’div’ length xs
-- where
-- a = 10
-- xs = [1,2,3,4,5]

n = a `div` length xs
    where
        a = 10
        xs = [1,2,3,4,5]

-- 4.The library function last selects the last element of a non-empty list;
-- for example, last [1,2,3,4,5] = 5.
-- Show how the function last could be defined in terms of the other
-- library functions introduced in this chapter.
-- Can you think of another possible definition?
last' l = l !! (length l - 1)

last'' l = head $ drop (length l - 1) l
-- *Main> list =  [1,2,3,4,5]
-- *Main> last' list
-- 5
-- *Main> last'' list
-- 5

-- 5.The library function init removes the last element from a non-empty list;
-- for example, init [1,2,3,4,5] = [1,2,3,4].
-- Show how init could similarly be defined in two different ways.
init' l = take (length l - 1) l

init'' []  = []
init'' [_] = []
init'' (x:xs) = x : init'' xs

-----------------------------------------
-- 3.11Exercises
-- 1.What are the types of the following values?
str :: [Char]
str = ['a','b','c']

tup :: (Char, Char, Char)
tup = ('a','b','c')

tups :: [(Bool, Char)]
tups = [(False,'O'),(True,'1')]

tup' :: ([Bool], [Char])
tup' = ([False,True],['0','1'])

funcs :: [[a] -> [a]]
funcs = [tail, init, reverse]

-- 2.Write down definitions that have the following types;
-- it does not matter what the definitions actually do as long as they are type correct.
bools :: [Bool]
bools = [True, True, False]

nums :: [[Int]]
nums = [[1,2],[3,4]]

add :: Int -> Int -> Int -> Int
add _ _ _ = 9

copy :: a -> (a,a)
copy x = (x, x)

apply :: (a -> b) -> a -> b
apply f x = f x

-- 3.What are the types of the following functions?
second :: [a] -> a
second xs = head (tail xs)

swap :: (a, b) -> (b, a)
swap (x,y) = (y,x)

pair :: a -> b -> (a, b)
pair x y = (x,y)

double' :: Num a => a -> a
double' x = x*2

palindrome :: Eq a => [a] -> Bool
palindrome xs = reverse xs == xs

twice :: (a -> a) -> a -> a
twice f x = f (f x)

-- Hint: take care to include the necessary class constraints in the types if
-- the functions are defined using overloaded operators.

-- 4.Check your answers to the preceding three questions using GHCi.
-- DONE

-- 5.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.
-- TODO: answer

----------------------------------------
-- 4.8Exercises
-- 1.Using library functions, define a function
--  halve :: [a] -> ([a],[a]) that splits an even-lengthed list into two halves.
-- For example:
-- > halve [1,2,3,4,5,6]
-- ([1,2,3],[4,5,6])
halve :: [a] -> ([a],[a])
halve xs = (take len xs, drop len xs)
        where len = length xs `div` 2

-- 2.Define a function third :: [a] -> a that
-- returns the third element in a list that contains at least this many elements using:
-- a.head and tail;
third :: [a] -> a
third = (head . tail . tail)
-- b.list indexing !!;
third' :: [a] -> a
third' = (!! 2)
-- c.pattern matching.
third'' :: [a] -> a
third'' (_:_:x:_) = x

-- 3.Consider a function safetail :: [a] -> [a] that behaves in the same way
-- as tail except that it maps the empty list to itself rather than producing an error.
-- Using tail and the function null :: [a] -> Bool that decides if a list is empty or not,
-- define safetail using:
-- a.a conditional expression;
safetail :: [a] -> [a]
safetail xs = if null xs then xs else tail xs
-- b.guarded equations;
safetail' :: [a] -> [a]
safetail' xs
    | null xs   = xs
    | otherwise = tail xs
-- c.pattern matching.
safetail'' :: [a] -> [a]
safetail'' [] = []
safetail'' (_:xs) = xs


-- 4.In a similar way to && in section 4.4,
-- show how the disjunction operator || can be defined
-- in four different ways using pattern matching.
disj :: Bool -> Bool -> Bool
True `disj` True   = True
True `disj` False  = True
False `disj` True  = True
False `disj` False = False

disj0 :: Bool -> Bool -> Bool
False `disj0` False = False
_ `disj0` _ = True

disj1 :: Bool -> Bool -> Bool
False `disj1` a = a
True `disj1` _ = True

disj2 :: Bool -> Bool -> Bool
a `disj2` b
    | a == b    = a
    | otherwise = True

-- 5.Without using any other library functions or operators,
-- show how the meaning of the following pattern matching definition for
-- logical conjunction && can be formalised using conditional expressions:
-- True && True = True
-- _ && _ = False
-- Hint: use two nested conditional expressions.

-- 6.Do the same for the following alternative definition,
-- and note the difference in the number of conditional expressions that are required:
-- True && b= b
-- False && _ = False

-- 7.Show how the meaning of the following curried function definition can be
-- formalised in terms of lambda expressions:
-- mult :: Int -> Int -> Int -> Int
-- mult x y z = x*y*z

-- 8.The Luhn algorithm is used to check bank card
-- numbers for simple errors such as mistyping a digit, and proceeds as follows:
-- consider each digit as a separate number;
-- moving left, double every other number from the second last;
-- subtract 9 from each number that is now greater than 9;
-- add all the resulting numbers together;
-- if the total is divisible by 10, the card number is valid.
-- Define a function luhnDouble :: Int -> Int
-- that doubles a digit and subtracts 9 if the result is greater than 9. For example:
-- > luhnDouble 3
-- 6

-- > luhnDouble 6
-- 3
-- Using luhnDouble and the integer remainder function mod, define a function luhn :: Int -> Int -> Int -> Int -> Bool that decides if a four-digit bank card number is valid. For example:
-- > luhn 1 7 8 4
-- True

-- > luhn 4 7 8 3
-- False
-- In the exercises for chapter 7 we will consider a more general version of this function that accepts card numbers of any length.

prog-in-hask.hs

import Data.Char

-- 1. Introduction
-- 1.1 Functions
double x = x + x

a = double 3

-- 1.5
-- Summing
sum' [] = 0
sum' (n:ns) = n + sum' ns

b = sum [1,2,3]

-- Sorting values
qsort [] = []
qsort (x:xs) = qsort smaller ++ [x] ++ qsort larger
               where
                   smaller = [a | a <- xs, a <= x]
                   larger  = [b | b <- xs, b > x]

-- Sequencing actions
seqn [] = return []
seqn (act:acts) = do x <- act
                     xs <- seqn acts
                     return (x:xs)

-- 2 First steps
-- 2.5 Haskell Scripts
quadruple x = double (double x)

factorial n = product [1..n]

average ns = sum ns `div` length ns

-- 3 ....
-- 4 Defining functions
-- 5 List comprehensions
-- 5.1 Basic concepts
concat' :: [[a]] -> [a]
concat' xss = [x | xs <- xss, x <- xs]

firsts :: [(a, b)] -> [a]
firsts ps = [x | (x,_) <- ps]

length' :: [a] -> Int
length' xs = sum [1 | _ <- xs]

-- 5.2 Guards
factors :: Int -> [Int]
factors n = [x | x <- [1..n], n `mod` x == 0]

prime :: Int -> Bool
prime n = factors n == [1,n]

primes :: Int -> [Int]
primes n = [x | x <- [2..n], prime x]

-- 5.3 The zip function
pairs :: [a] -> [(a, a)]
pairs xs = zip xs (tail xs)

sorted :: Ord a => [a] -> Bool
sorted xs = and [x <= y | (x, y) <- pairs xs]

positions :: Eq a => a -> [a] -> [Int]
positions x xs = [i | (x', i) <- zip xs [0..], x == x']

-- 5.4 String comprehensions
lowers :: String -> Int
lowers xs = length [x | x <- xs, x >= 'a' && x <= 'z']

count :: Char -> String -> Int
count x xs = length [x' | x' <- xs, x == x']

-- 5.5 The Caesar cipher
let2int :: Char -> Int
let2int c = ord c - ord 'a'

int2let :: Int -> Char
int2let n = chr (ord 'a' + n)

shift :: Int -> Char -> Char
shift n c
    | isLower c = int2let ((let2int c + n) `mod` 26)
    | otherwise = c

encode :: Int -> String -> String
encode n xs = [shift n x | x <- xs]

--- cracking
table :: [Float]
table = [8.1, 1.5, 2.8, 4.2, 12.7, 2.2, 2.0, 6.1, 7.0,
         0.2, 0.8, 4.0, 2.4, 6.7, 7.5, 1.9, 0.1, 6.0,
         6.3, 9.0, 2.8, 1.0, 2.4, 0.2, 2.0, 0.1]

percent :: Int -> Int -> Float
percent n m = (fromIntegral n / fromIntegral m) * 100

freqs :: String -> [Float]
freqs xs = [percent (count x xs) n | x <- ['a'..'z']]
    where n = lowers xs

chisqr :: [Float] -> [Float] -> Float
chisqr os es = sum [((o - e)^2) / e | (o, e) <- zip os es]

rotate :: Int -> [a] -> [a]
rotate n xs = drop n xs ++ take n xs

crack :: String -> String
crack xs = encode (-factor) xs
    where
        factor = head (positions (minimum chitab) chitab)
        chitab = [chisqr (rotate n table') table | n <- [0..25]]
        table' = freqs xs

-- 6 Recursive functions
-- 6.1 Basic concepts
fac :: Int -> Int
fac n = product [1..n]

fac' :: Int -> Int
fac' 0 = 1
fac' n = n * fac' (n-1)

-- 6.2 Recursion on lists
product' :: Num a => [a] -> a
product' []    = 1
product'(n:ns) = n * product' ns

length'' :: [a] -> Int
length'' []     = 0
length'' (_:xs) = 1 + length'' xs

reverse' :: [a] -> [a]
reverse' []     = []
reverse' (x:xs) = reverse' xs ++ [x]

-- (++0) :: [a] -> [a] -> [a]
-- [] ++0 ys    = ys
-- (x:xs) ++0 ys = x : (xs ++0 ys)

insert :: Ord a => a -> [a] -> [a]
insert x []                 = [x]
insert x (y:ys) | x <= y    = x : y : ys
                | otherwise = y : insert x ys

-- 6.3 Multiple arguments
zip' :: [a] -> [b] -> [(a, b)]
zip' [] _ = []
zip' _ [] = []
zip' (x:xs) (y:ys) = (x, y) : zip' xs ys

drop' :: Int -> [a] -> [a]
drop' 0 xs = xs
drop' _ [] = []
drop' n (_:xs) = drop' (n-1) xs

-- 6.4 Multiple recursion
fib :: Int -> Int
fib 0 = 0
fib 1 = 1
fib n = fib (n-2) + fib (n-1)

-- 7 Higher-order functions
-- 7.1 Basic concepts
add :: Int -> Int -> Int
add x y = x + y

add' :: Int -> (Int -> Int)
add' = \x -> (\y -> x + y)

twice :: (a -> a) -> a -> a
twice f x = f (f x)

-- 7.2 Processing lists
map' :: (a -> b) -> [a] -> [b]
map' f xs = [f x | x <- xs]

map'' :: (a -> b) -> [a] -> [b]
map'' f []     = []
map'' f (x:xs) = f x : map f xs

filter' :: (a -> Bool) -> [a] -> [a]
filter' p xs = [x | x <- xs, p x]

filter'' :: (a -> Bool) -> [a] -> [a]
filter'' p []                 = []
filter'' p (x:xs) | p x       = x : filter'' p xs
                  | otherwise = filter'' p xs

sumsqreven :: [Int] -> Int
sumsqreven ns = sum (map (^2) (filter even ns))

-- 7.3 The foldr function
-- sum [] = 0
-- sum (x:xs) = x + sum xs

-- product [] = 1
-- product (x:xs) = x * product xs

or' [] = False
or' (x:xs) = x || or xs

and' [] = True
and' (x:xs) = x && and xs

sum'' :: Num a => [a] -> a
sum'' = foldr (+) 0

product'' :: Num a => [a] -> a
product'' = foldr (*) 1

or'' :: [Bool] -> Bool
or'' = foldr (||) False

and'' :: [Bool] -> Bool
and'' = foldr (&&) True

foldr' :: (a -> b -> b) -> b -> [a] -> b
foldr' f v []     = v
foldr' f v (x:xs) = f x (foldr' f v xs)

length''' :: [a] -> Int
length''' = foldr' (\_ n -> 1 + n) 0

reverse'' :: [a] -> [a]
reverse'' = foldr' snoc []

snoc x xs = xs ++ [x]

-- 7.4 The foldl function