I'm trying to break out of my imperative mind-set by learning Haskell in small snippets. After a few successes I've hit a bit of a roadblock with one of the classic dynamic programming problems, the longest increasing subsequence: http://en.wikipedia.org/wiki/Longest_increasing_subsequence The most efficient algorithm relies on destructive updates, so a simple translation doesn't seem possible. I've been trying to think of a way of removing the need for destructive updates while keeping the efficiency, but so far without much luck. Ideally, I'd like to avoid threading the whole thing with a state monad, since then it would just be an imperative algorithm in disguise. Any suggestions would be very gratefully appreciated. Cheers, Matt
The article mentioned in this thread addresses a similar problem: http://lambda-the-ultimate.org/classic/message8282.html The main idea is to start by expressing the straightforward, inefficient solution ,in this case something like: liss = maximumBy length . filter ascending . concat . map inits . tails (with ascending :: (Ord a) => [a] -> Bool defined appropriately) Then apply a series of manipulations to it (each justified by a theorem) in order to arrive at the functional version of your favorite algorithm =) Some known names for (instances/applications of) this technique are map/fold fusion, deforestation and MapReduce. All the cool kids go bananas over it ;) -- Ariel J. Birnbaum
liss = maximumBy length . filter ascending . concat . map inits . tails Of course my solution is braindamaged since I skipped this bit of the definition: [quote]Note that subsequence we are searching for is not necessarily contiguous[/quote]. Like the article says, without this detail the problem is quite trivial =P Replace concat . map inits . tails with foldr (\x xss -> xss ++ map (x:) xss) [[]]
for a correct (yet even more inefficient) solution. I'd blame the mistake on the late hour, but it was even later when I noticed... *shame* -- Ariel J. Birnbaum
On Thursday 10 April 2008 01:20:49 pm Matt Amos wrote:
I'm trying to break out of my imperative mind-set by learning Haskell in small snippets. After a few successes I've hit a bit of a roadblock with one of the classic dynamic programming problems, the longest increasing subsequence:
http://en.wikipedia.org/wiki/Longest_increasing_subsequence
The most efficient algorithm relies on destructive updates, so a simple translation doesn't seem possible. I've been trying to think of a way of removing the need for destructive updates while keeping the efficiency, but so far without much luck. Ideally, I'd like to avoid threading the whole thing with a state monad, since then it would just be an imperative algorithm in disguise.
Any suggestions would be very gratefully appreciated.
Memorization is a nice way to implement dynamic programming algorithms in Haskell. Basically, you arrange it so that the underlying runtime does the destructive updates for you. http://www.haskell.org/haskellwiki/Memoization
Cheers,
Matt
You can translate the following algorithm (written in Maple 11), which
can be made purely functional. [For the cognoscenti: attributes are
implemented in-place in Maple, but that is really just an instance of
the Decorator pattern which can be just as easily implemented with a
functional Map]. Note that all the assignments below are really just
let bindings.
Jacques
longestIncreasingSequence := proc(L::list)
local n,i,j,G;
uses GraphTheory;
n := nops(L);
G := Digraph(n
, {seq(seq(`if`(L[i]
G'day all.
Quoting Matt Amos
http://en.wikipedia.org/wiki/Longest_increasing_subsequence
The most efficient algorithm relies on destructive updates, so a simple translation doesn't seem possible.
Given that it's based on binary search, you might like to try using a binary search tree. You may or may not have discovered that the quadratic algorithm has a more-or-less direct translation into Haskell using lazy arrays. Did you have a go at implementing that first? Cheers, Andrew Bromage
It is late, but I was not sleepy enough, so here is my first translation of the
algorithm to a functional approach...
{- Quote wikipedia: http://en.wikipedia.org/wiki/Longest_increasing_subsequence
L = 0
M[0] = 0
for i = 1, 2, ... n:
binary search for the largest j ≤ L such that X[M[j]] < X[i] (or set j = 0
if no such value exists)
P[i] = M[j]
if j == L or X[i] < X[M[j+1]]:
M[j+1] = i
L = max(L, j+1)
-}
{-
X[i] defined for i = 1,2,3…
So X[0] is not defined.
Now, rethink '0' as Nothing, and 1≤j≤L since X[M[0]] is also undefined.
Not that after the binary search that one the three conditions holds:
X[i] ≤ X[M[1]]
"The same or a new minimum value"
P[i] is created and set to Nothing
If X[i] < X[M[1]] then M[1] is changed to i
X[M[j]] < X[i] ≤ X[M[j+1]] for some j
My late night suggestions were nearly correct. I have actually written the code now. Once keeping track of indices, and a second time without them:
{-# LANGUAGE BangPatterns #-} -- By Chris Kuklewicz, copyright 2008, BSD3 license -- Longest increasing subsequence -- (see http://en.wikipedia.org/wiki/Longest_increasing_subsequence) import Data.List (foldl') import Data.Map (Map) import qualified Data.Map as M (empty,null,insert,findMin,findMax ,splitLookup,deleteMin,delete)
type DList a = [a] -> [a]
lnds :: Ord a => [a] -> [a] lnds = lnds_decode . lnds_fold
lnds_fold :: Ord a => [a] -> Map a (DList a) lnds_fold = foldl' process M.empty where -- The Map keys, in sorted order, are the input values which -- terminate the longest increasing chains of length 1,2,3,… process mu x = case M.splitLookup x mu of (_,Just {},_) -> mu -- ignore x when it is already an end of a chain
(map1,Nothing,map2) | M.null map2 -> -- insert new maximum element x if M.null mu then M.insert x (x:) mu -- x is very first element else let !xs = snd (M.findMax mu) in M.insert x (xs . (x:)) mu
| M.null map1 -> -- replace minimum element with smaller x M.insert x (x:) (M.deleteMin mu)
| otherwise -> -- replace previous element oldX with slightly smaller x let !xs = snd (M.findMax map1) !oldX = fst (M.findMin map2) -- slightly bigger key !withoutOldX = M.delete oldX mu in M.insert x (xs . (x:)) withoutOldX
lnds_decode :: Ord a => Map a (DList a) -> [a] lnds_decode mu | M.null mu = [] | otherwise = snd (M.findMax mu) []
tests = [ ['b'..'m'] == (lnds $ ['m'..'s'] ++ ['b'..'g'] ++ ['a'..'c'] ++ ['h'..'k'] ++ ['h'..'m'] ++ ['d','c'..'a']) , "" == lnds "" , "a" == lnds "a" , "a" == lnds "ba" , "ab" == lnds "ab" ]
Comparing to wikipedia: The X[M[1]],X[M[2]],… sequence is strictly increasing. These are the ends of the current increasing chains of length 1,2,… and they are the keys to the Map in my code. The values of the map are the subsequences themselves, in DList form. Instead of pointing to the index of the previous element I just lookup '!xs' and append '(x:)' to that. Complexity: The strictness annotations ensure that the garbage collector can destroy any unreachable DList entries. The space usage is thus O(N) and may be O(1) for certain inputs (such as the best case of never-increasing input list). A strictly increasing input list is the worst case for space usage. The naive time complexity of 'process' for the i'th input value is O(log i). This can be double checked by looking at the time complexity of everything I import from Data.Map. Peak performance could be had by (1) adding the first element before the foldl' to avoid checking for this case in process (2a) accessing the internal map structure to optimize the splitLookup->delete->insert case into a single operation (2b) Using something like a zipper to access the to-be-deleted-and-replaced element of the map The (2a) and (2b) work because we know the changed key will go into the same 'slot' of the map as the old one. -- Chris
participants (6)
-
ajb＠spamcop.net -
Ariel J. Birnbaum -
ChrisK -
Jacques Carette -
Matt Amos -
Robert Dockins