Divide and Conquer
1. Divide and Conquer
A divide and conquer algorithm is one which:
- Splits the problem into smaller subproblems.
- Solve the subproblems and turn them into subsolutions.
- We combine the subsolutions to form a solution.
1.1 Merge Sort
1splitAt :: [a] -> Int -> ([a], [a]) -- O(n) 2splitAt xs n = (take n xs, drop n xs)
This function can be used to make a list small:
1splitHalf :: [a] -> ([a], [a]) -- O(n) 2splitHalf xs = splitAt xs (length xs `div` 2)
We now need to think about step 3. How do we combine the sub solutions? The sub-problem is a smaller unsorted list, the subsolution is a smaller, sorted list. Let's write merge:
1merge :: Ord a => [a] -> [a] -> [a] -- O(m + n) 2merge [] ys = ys 3merge xs [] = xs 4merge xxs@(x:xs) yys@(y:ys) 5 | x <= y = x : merge xs yys 6 | otherwise = y : merge xxs ys
Now we have a step 1 and step 3, we can make a divide and conquer algorithm. To do this, we need to sort trivial sub-problem:
1msort :: Ord a => [a] -> [a] 2msort [] = [] 3msort [x] = [x] 4msort xs = 5 -- step (1) divide into subproblems 6 let (us, vs) = splitHalf xs 7 -- step (2) solve the subproblems 8 us' = msort us 9 vs' = msort vs 10 -- step (3) combine the subsolutions 11 in merge us' vs'
What is the complexity of xs?
The best and worst case of merge sort is
1.2 Quick Sort
Quick sort is another divide and conquer algorithm. Now, the subproblem involves partitioning:
1partition :: (a -> Bool) -> [a] -> ([a], [a]) -- O(n) 2partition p xs = (filter p xs, filter (not . p) xs)
The idea will be to take everything less than an element and everything greater than it:
allLess :: Ord a => a -> [a] -> ([a], [a]) -- O(n)
allLess x xs = partition (< x) xs
We can combine the subproblems just by putting them in the right order:
1qsort :: Ord a => [a] -> [a] 2qsort [] = [] 3qsort (x:xs) = 4 let (us, vs) = allLess x xs 5 us' = qsort us 6 vs' = qsort vs 7 in us' ++ [x] ++ vs'
What is the complexity? Quicksort doesn't always behave the same way/ The best case is where the list is optimally unsorted:
In the worst case, the list is already sorted:
It may be better to take a random element of the list, it is expected that the list will be split more evenly.
2. Dynamic Programming
Dynamic programming is about:
- Writing a bad solution recursively.
- Caching the sub-solutions.
- Profit?
2.1 Fibonacci
A classic example of dynamic programming is:
fib :: Int -> Int -- O(2^n)
fib 0 = 0
fib 1 = 1
fib n = fib (n - 1) + fib (n - 2)
Dynamic programming helps with this, but retains the nice formulation. We need an efficient table, we don't know that, and we feel like we need mutation, we don't have that. We could use Arrays!
1import Data.Array 2 3(!!) :: [a] -> Int -> a -- O(n) 4(!) :: Ix i => Array i a -> i -> a
The class Ix describes indexable things:
1index0 :: Ix i => i -> i -> Int 2index0 n i = i 3index0 (n, _) (i, j) = i * n + j 4index0 (n, m, ) (i, j, k) = i * n * m + j * m + k
The point is that Haskell arrays are not limited to indexing on Int, they can be any amount of dimensions, etc. We can also construct arrays:
1array :: Ix i => (i, i) -> [(i, a)] -> Array i a 2range :: Ix i => (i, i) -> [i]
We are going to build yourself a helper function:
1tabulate :: Ix i => (i, i) -> (i -> a) -> Array i A 2tabulate bounds f = array bounds [(i, f i) | i <- range bounds]
Haskell is lazy, which lets us do this:
1fib' :: Int -> Integer -- O(n) 2fib' n = table ! n 3 where table :: Array Int Integer 4 table = tabulate (0, n) memo 5 6 memo :: Int -> Integer 7 memo 0 = 0 8 memo 1 = 1 9 memo i = table ! (i - 1) + table ! (i - 2)
The trick is to ensure that laziness resolves the array elements. However, the space complexity has to O(n). This isn't always the cast and some dynamic programming problems have smaller space solutions. Is the problem in question has a static known number of dependencies, and these dependencies are local to each other, we could do better. Namely, we can create a sliding window. As an example, here is a better fib:
1fib'' :: Int -> Integer 2fib'' n = loop 1 1 n 3 where loop :: Integer -> Integer -> Int -> Integer 4 loop zero one 0 = zero 5 loop zero one 1 = one 6 loop nMinus2 nMinus1 n = loop nMinus1 (nMinus2 + nMins1) (n - 1)
This works because fib has 2 known subproblems at each step, and they are neighbours. It does not work in general. Just for fun:
1fib''' :: Int -> Integer 2fib''' n = fibs !! n 3 where fibs = 1 : 1 : zipWith (+) fibs (tail fibs)
2.2 Exact Change
1type Pence = Int 2coins :: [Pence] 3coins = [1, 2, 3, 5, 10, 20, 50, 100, 200]
The problem is the exact change problem: the minimum number of coins needed to make the exact total.
1change :: Pence -> Int -- O(8^n) 2change 0 = 0 3change g = minimum [change (g - coin) + 1 | coin <- coins, coin <= g]
With this code, calculating
change 29takes over5 GBof memory. Bad :(
The recipe is to find the array, make it in terms of itself, and take the right element:
1change' :: Pence -> Integer -- O (n) 2change' n = table ! n 3 where table :: Array Pence Int 4 table = tabulate (0, n) memo 5 6 memo :: Pence -> Int -- O(1) 7 memo 0 = 0 8 memo g = minimum [table ! (g - coin) + 1 | coin <- coins, coin <= g]
This now takes
138KBof memory.
2.3 Edit Distance
Given two strings str1 and str2, dist str1 str2 gives us the number of single-character -additions, -removals, or -changes required to transform one into the other.
1dist "hello" "hello" = 0 2dist "hello" "world" = 4 3dist "cat" "at" = 1
It seems like there may be a relation between distance of strings and distances of smaller, similar sub-strings. This suggest to use a divide and conquer algorithm. We can start by defining the trivial subproblems:
1dist :: String -> String -> Int 2dist "" str2 = length str2 -- O(n) 3dist str1 "" = length str1 -- O(m)
Now we can consider how to break down a larger problem. Since we know that the strings aren't empty, we can use dist (c1 : cs1) (c2 : cs2). From here, we can consider the three possible operations:
dist cs1 (c2:cs2)- Remove a character from the first string, making the problem smaller.dist (c1:cs1) cs2- Remove a character from the second string, making the problem smaller.dist cs1 cs2- Removing a character from both strings ifc1 == c2. This requires no cost.
1dist (c1 : cs1) (c2 : cs2) = minimum [ 2 dist cs1 (c2 : cs2) + 1, 3 dist (c1 : cs1) cs2 + 1, 4 dist cs1 cs2 + (if c1 == c2 then 0 else 1) 5 ]
Every time we recurse, we have three sub-problems to explore; these subproblems are only 1 character smaller than their parent problem. Worst case then, when the strings have length dist "" [c]. Hence, there are tabulate and Arrays.
However, we cannot come up with a reasonable way of indexing strings (finding Ix String) as there are no sensible bounds on how big a string can get. Instead of storing the string at each step, can we reformat the problem to store how much of the string is left to process as an Int:
1dist' :: String -> String -> Int 2dist' str1 str2 = go m n 3 where go :: Int -> Int -> Int 4 go 0 j = j -- Cheaper! 5 go i 0 = i 6 go i j = minimum [ 7 go (i - 1) j + 1, 8 go i (j - 1) + 1, 9 go (i - 1) (j - 1) + if c1 == c2 then 0 else 1 10 ] 11 where c1 = str1 !! (m - i) 12 c2 = str2 !! (n - j) 13 m = length str1 14 n = length str2
This is even worse time complexity than before. This time, for some of the recursive calls, we have to perform a !! operation, which is tabulate to memoize the results of the subproblems. It is trivial to notice that the size of the table is
1type Text = Array Int Char 2 3fromString :: String -> Text -- O(n) 4fromString cs = listArray (0, length cs - 1) cs 5 6dist'' :: String -> String -> Int 7dist'' cs1 cs2 = table ! (m, n) 8 where table :: Array (Int, Int) Int 9 table = tabulate ((0, 0), (m, n)) (uncurry memo) 10 11 memo :: Int -> Int -> Int 12 memo 0 j = j 13 memo i 0 = i 14 memo i j = minimum 15 [ table ! (i - 1, j) + 1 16 , table ! (i, j - 1) + 1 17 , table ! (i - 1, j - 1) + if c1 == c2 then 0 else 1 18 ] 19 where c1 = cs1 ! (m - i) 20 c2 = cs2 ! (n - j) 21 22 m = length cs1 23 n = length cs2 24 25 str1, str2 :: Text 26 str1 = fromString cs1 27 str2 = fromString cs2
This time, each call to memo is
2.4 Evidence of Work
What if we wanted to show the steps we took to achieve an answer? Let's go back to the change problem. Just telling us the number of coins needed doesn't tell us how to get there, we need to know which coins were used.
Notice, here an interesting relationship is formed between
Int ~ [a]where0 ~ []and(+1) ~ (:). Thinking in this way, we can also relateMaybe ~ BoolwhereNothing ~ FalseandJust ~ True, onlyJustprovides a witness for how we determinedTrue.
1type Pence = Int 2coins :: [Pence] 3coins = [1, 2, 3, 5, 10, 20, 50, 100, 200] 4 5change :: Pence -> [Pence] 6change g = table ! g 7 where table :: Array Pence [Pence] 8 table = tabulate (0, g) memp 9 10 memo :: Pence -> [Pence] 11 memo 0 = [] 12 memo g = minimumBy (compare `on` length) 13 [ coin : (table ! (g - coin)) | coin <- coins, coin <= g ]
Here, instead of using minimum, we use minimumBy, which takes a comparison function. However, if minimum is complexity minimumBy is Seq, which has length:
1change' :: Pence -> [Pence] -- O(n) 2change' g = Seq.toList (table ! g) 3 where table :: Array Pence (LenList Pence) 4 table = tabulate (0, g) memp 5 6 memo :: Pence -> LenList Pence 7 memo 0 = Seq.nil 8 memo g = minimumBy (compare `on` Seq.length) 9 [ Seq.cons coin (table ! (g - coin)) | coin <- coins, coin <= g ]
How would we do this for the edit distance problem? How would we show every step taken to get from one string to another?
1editsBad :: String -> String -> [String] 2editsBad "" cs2 = inits cs2 3editsBad cs1 "" = tails cs1 4editsBad (c1:cs1) (c2:cs2) = minimumBy (compare `on` length) 5 [ (c1:cs1) : editsBad cs1 (c2:cs2) 6 , (c1:cs1) : map (c2 :) (editsBad (c1:cs1) cs2) 7 , (if c1 == c2 then id else ((c1:cs1) :)) (map (c2 :) (editsBad cs1 cs2)) 8 ]
Here, unlike last time, we return a list of strings. Every recursion, we add the new step to the list. This is once again bad on complexity, but we can improve the minimumBy by using Seq:
1edits :: String -> String -> [String] 2edits str1 str2 = Seq.toList (go str1 str2) 3 where go :: String -> String -> LenList String 4 go "" cs2 = Seq.inits cs2 5 go cs1 "" = Seq.tails cs1 6 go (c1 : cs1) (c2 : cs2) = minimumBy (compare `on` Seq.length) 7 [ Seq.cons (c1 : cs1) (go cs1 (c2 : cs2)) 8 , Seq.cons (c1 : cs1) (Seq.map (c2 :) (go (c1 : cs1) cs2)) 9 , (if c1 == c2 then id else Seq.cons (c1 : cs1)) (Seq.map (c2 :) (go cs1 cs2)) 10 ]
Finally, lets finish with tabulate:
1edits' :: String -> String -> [String] 2edits' cs1 cs2 = Seq.toList $ table ! (m, n) 3 where table :: Array (Int, Int) (LenList String) 4 table = tabulate ((0, 0), (m, n)) (uncurry memo) 5 6 memo :: Int -> Int -> LenList String 7 memo 0 j = Seq.inits $ drop (n - j) cs2 8 memo i 0 = Seq.tails $ drop (m - i) cs1 9 memo i j = minimumBy (compare `on` Seq.length) 10 [ Seq.cons cs1' (table ! (i - 1, j)) 11 , Seq.cons cs1' (Seq.map (c2 :) (table ! (i, j - 1))) 12 , (if c1 == c2 then id else Seq.cons cs1') (Seq.map (c2 :) (table ! (i - 1, j - 1))) 13 ] 14 where c1 = str1 (m - i) 15 c2 = str2 (n - j) 16 cs1' = drop (m - i) cs1 17 18 m = length cs1 19 n = length cs2 20 21 str1, str2 :: Text 22 str1 = fromString cs1 23 str2 = fromString cs2
Unlike before, the drops, inits and tails mean that the complexity is not as good as