--  Haskell: The Craft of Functional Programming
--  Simon Thompson
--  (c) Addison-Wesley, 1996-2010.

--  Chapter 20

-- Time and space behaviour
-- ^^^^^^^^^^^^^^^^^^^^^^^^

module Chapter20 where

import Prelude hiding (map)

-- Various functions whose complexity is discussed.
-- ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

-- Naive Fibonacci function

fib :: Integer -> Integer

fib :: Integer -> Integer
fib Integer
0 = Integer
0
fib Integer
1 = Integer
1
fib Integer
m = Integer -> Integer
fib (Integer
mInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
2) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer -> Integer
fib (Integer
mInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
1)

-- Naive factorial function

fac :: Integer -> Integer
fac :: Integer -> Integer
fac Integer
0 = Integer
1
fac Integer
n = Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer -> Integer
fac (Integer
nInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
1)

-- Insertion sort

iSort :: Ord a => [a] -> [a]

iSort :: forall a. Ord a => [a] -> [a]
iSort []     = []
iSort (a
x:[a]
xs) = a -> [a] -> [a]
forall a. Ord a => a -> [a] -> [a]
ins a
x ([a] -> [a]
forall a. Ord a => [a] -> [a]
iSort [a]
xs)

ins :: Ord a => a -> [a] -> [a]

ins :: forall a. Ord a => a -> [a] -> [a]
ins a
x [] = [a
x]
ins a
x (a
y:[a]
ys) 
  | (a
xa -> a -> Bool
forall a. Ord a => a -> a -> Bool
<=a
y)      = a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ys
  | Bool
otherwise   = a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:a -> [a] -> [a]
forall a. Ord a => a -> [a] -> [a]
ins a
x [a]
ys

-- Quicksort

qSort :: Ord a => [a] -> [a]

qSort :: forall a. Ord a => [a] -> [a]
qSort []     = []
qSort (a
x:[a]
xs) = [a] -> [a]
forall a. Ord a => [a] -> [a]
qSort [a
z|a
z<-[a]
xs,a
za -> a -> Bool
forall a. Ord a => a -> a -> Bool
<=a
x] [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
x] [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a] -> [a]
forall a. Ord a => [a] -> [a]
qSort [a
z|a
z<-[a]
xs,a
za -> a -> Bool
forall a. Ord a => a -> a -> Bool
>a
x]

-- Two reverse functions

rev1 :: [a] -> [a]
rev1 []     = []
rev1 (a
x:[a]
xs) = [a] -> [a]
rev1 [a]
xs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
x]

rev2 :: [a] -> [a]
rev2            = [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
shunt []
shunt :: [a] -> [a] -> [a]
shunt [a]
xs []     = [a]
xs
shunt [a]
xs (a
y:[a]
ys) = [a] -> [a] -> [a]
shunt (a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs) [a]
ys

-- Two multiplication functions

mult :: a -> t -> a
mult a
n t
0 = a
0
mult a
n t
m = a -> t -> a
mult a
n (t
mt -> t -> t
forall a. Num a => a -> a -> a
-t
1) a -> a -> a
forall a. Num a => a -> a -> a
+ a
n

russ :: a -> t -> a
russ a
n t
0 = a
0
russ a
n t
m 
  | (t
m t -> t -> t
forall a. Integral a => a -> a -> a
`mod` t
2 t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
0)    = a -> t -> a
russ (a
na -> a -> a
forall a. Num a => a -> a -> a
+a
n) (t
m t -> t -> t
forall a. Integral a => a -> a -> a
`div` t
2)
  | Bool
otherwise           = a -> t -> a
russ (a
na -> a -> a
forall a. Num a => a -> a -> a
+a
n) (t
m t -> t -> t
forall a. Integral a => a -> a -> a
`div` t
2) a -> a -> a
forall a. Num a => a -> a -> a
+ a
n

-- The merge sort function 

mSort :: Ord a => [a] -> [a]

mSort :: forall a. Ord a => [a] -> [a]
mSort [a]
xs 
  | (Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2)   = [a]
xs
  | Bool
otherwise   = [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
mer ([a] -> [a]
forall a. Ord a => [a] -> [a]
mSort (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
m [a]
xs)) ([a] -> [a]
forall a. Ord a => [a] -> [a]
mSort (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
m [a]
xs))
    where
    len :: Int
len = [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs
    m :: Int
m   = Int
len Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2

mer :: Ord a => [a] -> [a]  -> [a]

mer :: forall a. Ord a => [a] -> [a] -> [a]
mer (a
x:[a]
xs) (a
y:[a]
ys) 
  | (a
xa -> a -> Bool
forall a. Ord a => a -> a -> Bool
<=a
y)      = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
mer [a]
xs (a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ys)
  | Bool
otherwise   = a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
mer (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs) [a]
ys
mer (a
x:[a]
xs) []   = (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs)
mer []     [a]
ys   = [a]
ys

-- Implementations of sets
-- ^^^^^^^^^^^^^^^^^^^^^^^

-- Sets implemented as _unordered_ lists.

-- type Set a = [a]

-- empty        = []
-- memSet       = member
-- inter xs ys  = filter (member xs) ys
-- union        = (++)
-- subSet xs ys = and (map (member ys) xs)
-- eqSet xs ys  = subSet xs ys && subSet ys xs
-- makeSet      = id
-- mapSet       = map
--  


-- Space behaviour
-- ^^^^^^^^^^^^^^^

-- Lazy evaluation
-- ^^^^^^^^^^^^^^^

-- List examples

exam1 :: a -> [a]
exam1 a
n = [a
1 .. a
n] [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
1 .. a
n]

exam2 :: a -> [a]
exam2 a
n = [a]
list [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
list 
          where 
          list :: [a]
list=[a
1 .. a
n]

exam3 :: a -> [a]
exam3 a
n = [a
1 .. a
n] [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [[a] -> a
forall a. HasCallStack => [a] -> a
last [a
1 .. a
n]]

exam4 :: a -> [a]
exam4 a
n = [a]
list [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [[a] -> a
forall a. HasCallStack => [a] -> a
last [a]
list]
          where
          list :: [a]
list=[a
1 .. a
n]


-- Saving space?
-- ^^^^^^^^^^^^^

-- A new version of factorial

newFac :: Integer -> Integer
newFac :: Integer -> Integer
newFac Integer
n = Integer -> Integer -> Integer
aFac Integer
n Integer
1

aFac :: Integer -> Integer -> Integer
aFac :: Integer -> Integer -> Integer
aFac Integer
0 Integer
p = Integer
p
aFac Integer
n Integer
p = Integer -> Integer -> Integer
aFac (Integer
nInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
1) (Integer
pInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
n)

-- This can be modified thus:
--  aFac n p
--    | p==p        = aFac (n-1) (p*n)

-- Miscellaneous functions

sumSquares :: Integer -> Integer
sumSquares :: Integer -> Integer
sumSquares Integer
n = [Integer] -> Integer
sumList ((Integer -> Integer) -> [Integer] -> [Integer]
forall {t :: * -> *} {a} {b}. Foldable t => (a -> b) -> t a -> [b]
map Integer -> Integer
forall {a}. Num a => a -> a
sq [Integer
1 .. Integer
n])

sumList :: [Integer] -> Integer
sumList = (Integer -> Integer -> Integer) -> Integer -> [Integer] -> Integer
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+) Integer
0
sq :: a -> a
sq a
n    = a
na -> a -> a
forall a. Num a => a -> a -> a
*a
n



-- Folding revisited
-- ^^^^^^^^^^^^^^^^^

-- Map defined using foldr

map :: (a -> b) -> t a -> [b]
map a -> b
f = (a -> [b] -> [b]) -> [b] -> t a -> [b]
forall a b. (a -> b -> b) -> b -> t a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((:)(b -> [b] -> [b]) -> (a -> b) -> a -> [b] -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.a -> b
f) []

-- Factorial using foldr

facFold :: b -> b
facFold b
n = (b -> b -> b) -> b -> [b] -> b
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr b -> b -> b
forall a. Num a => a -> a -> a
(*) b
1 [b
1 .. b
n]

-- Examples

foldEx1 :: a -> Bool
foldEx1 a
n = (Bool -> Bool -> Bool) -> Bool -> [Bool] -> Bool
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Bool -> Bool -> Bool
(&&) Bool
True ((a -> Bool) -> [a] -> [Bool]
forall {t :: * -> *} {a} {b}. Foldable t => (a -> b) -> t a -> [b]
map (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
2) [a
2 .. a
n])



-- Avoiding re-computation: memoization
-- ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

-- The Fibonacci numbers

-- A naive algorithm is given earlier in this script.

-- An algorithm which returns a pair of consecutive Fibonacci numbers.

fibP :: Integer -> (Integer,Integer)

fibP :: Integer -> (Integer, Integer)
fibP Integer
0 = (Integer
0,Integer
1)
fibP Integer
n = (Integer
y,Integer
xInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
y)
         where
         (Integer
x,Integer
y) = Integer -> (Integer, Integer)
fibP (Integer
nInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
1)

-- The list of Fibonacci values, defined directly.

fibs ::[Integer]

fibs :: [Integer]
fibs = Integer
0 Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: Integer
1 Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: (Integer -> Integer -> Integer)
-> [Integer] -> [Integer] -> [Integer]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+) [Integer]
fibs ([Integer] -> [Integer]
forall a. HasCallStack => [a] -> [a]
tail [Integer]
fibs)


-- Dynamic programming: maximal common subsequence
-- ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

-- The naive algorithm ...

mLen :: Eq a => [a] -> [a] -> Integer

mLen :: forall a. Eq a => [a] -> [a] -> Integer
mLen [a]
xs []        = Integer
0
mLen [] [a]
ys        = Integer
0
mLen (a
x:[a]
xs) (a
y:[a]
ys) 
  | a
xa -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
y        = Integer
1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ [a] -> [a] -> Integer
forall a. Eq a => [a] -> [a] -> Integer
mLen [a]
xs [a]
ys
  | Bool
otherwise   = Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
max ([a] -> [a] -> Integer
forall a. Eq a => [a] -> [a] -> Integer
mLen [a]
xs (a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ys)) ([a] -> [a] -> Integer
forall a. Eq a => [a] -> [a] -> Integer
mLen (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs) [a]
ys)

-- ... translated to talk about sub-components of lists, described by their
-- endpoints ...

maxLen :: Eq a => [a] -> [a] -> Int -> Int -> Int

maxLen :: forall a. Eq a => [a] -> [a] -> Int -> Int -> Int
maxLen [a]
xs [a]
ys Int
0 Int
j = Int
0 
maxLen [a]
xs [a]
ys Int
i Int
0 = Int
0
maxLen [a]
xs [a]
ys Int
i Int
j
  | [a]
xs[a] -> Int -> a
forall a. HasCallStack => [a] -> Int -> a
!!(Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== [a]
ys[a] -> Int -> a
forall a. HasCallStack => [a] -> Int -> a
!!(Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)  = ([a] -> [a] -> Int -> Int -> Int
forall a. Eq a => [a] -> [a] -> Int -> Int -> Int
maxLen [a]
xs [a]
ys (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
  | Bool
otherwise               = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max ([a] -> [a] -> Int -> Int -> Int
forall a. Eq a => [a] -> [a] -> Int -> Int -> Int
maxLen [a]
xs [a]
ys Int
i (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))
                                  ([a] -> [a] -> Int -> Int -> Int
forall a. Eq a => [a] -> [a] -> Int -> Int -> Int
maxLen [a]
xs [a]
ys (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int
j)

-- ... and then transliterated into a memoised version.

maxTab ::  Eq a => [a] -> [a] -> [[Int]]

maxTab :: forall a. Eq a => [a] -> [a] -> [[Int]]
maxTab [a]
xs [a]
ys
  = [[Int]]
result
    where 
    result :: [[Int]]
result = [Int
0,Int
0 .. ] [Int] -> [[Int]] -> [[Int]]
forall a. a -> [a] -> [a]
: (Int -> [Int] -> [Int]) -> [Int] -> [[Int]] -> [[Int]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> [Int] -> [Int]
forall {a}. (Ord a, Num a) => Int -> [a] -> [a]
f [Int
0 .. ] [[Int]]
result
    f :: Int -> [a] -> [a]
f Int
i [a]
prev  
        = [a]
ans
          where
          ans :: [a]
ans   = a
0 a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (Int -> a -> a) -> [Int] -> [a] -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> a -> a
g [Int
0 .. ] [a]
ans
          g :: Int -> a -> a
g Int
j a
v 
            | [a]
xs[a] -> Int -> a
forall a. HasCallStack => [a] -> Int -> a
!!Int
i a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== [a]
ys[a] -> Int -> a
forall a. HasCallStack => [a] -> Int -> a
!!Int
j      = [a]
prev[a] -> Int -> a
forall a. HasCallStack => [a] -> Int -> a
!!Int
j a -> a -> a
forall a. Num a => a -> a -> a
+ a
1
            | Bool
otherwise           = a -> a -> a
forall a. Ord a => a -> a -> a
max a
v ([a]
prev[a] -> Int -> a
forall a. HasCallStack => [a] -> Int -> a
!!(Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1))