countPaths - in haskell

[[countPaths]]

Build a map from a list of (key, value) pairs (arg2) given a way to combine together values sharing the same key (arg1).\n\nfromListWith :: Ord k => (a -> a -> a) -> [(k, a)] -> Map k a\n\n[[via|http://www.haskell.org/ghc/docs/6.4.2/html/libraries/base/Data-Map.html#v:fromListWith]]\n

A map with a single element.\n\nhttp://www.haskell.org/ghc/docs/6.4.2/html/libraries/base/Data-Map.html#v%3Asingleton

Combine together maps given a way to combine together values sharing the same key in different maps.\n\nunionWith :: Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a\n\n[[via|http://haskell.org/ghc/docs/latest/html/libraries/base/Data-Map.html#v%3AunionWith]]

<<search>><<closeAll>><<permaview>>{{plain{[[comments|http://programming.reddit.com/info/gbz8/comments]]}}}<<newTiddler>><<newJournal 'DD MMM YYYY'>><<saveChanges>><<slider chkSliderOptionsPanel OptionsPanel 'options »' 'Change TiddlyWiki advanced options'>>

in haskell

countPaths

/***\nPlace your custom CSS here\n***/\n/*{{{*/\n.code {\nborder: 1px solid #fe8;\nfont-family: monospace;\nfont-size: 120%;\nbackground: #ffc;\npadding-left: 3em;\n}\n.comment {\ncolor: #7f7f7f;\n}\n.comment a {\ncolor: #7f7fff;\n}\n\n.test {\nborder: 1px solid #999;\nfont-family: monospace;\nfont-size: 120%;\nbackground: #ccc;\npadding-left: 3em;\n}\n.output {\nborder: 1px solid #999;\nfont-family: monospace;\nfont-size: 120%;\nbackground: #000;\ncolor: #0f0;\npadding-left: 3em;\n}\n.prompt {\nfont-family: monospace;\nbackground: #000;\ncolor: #0f0;\n}\n.plain a {\ncolor: #000;\ntext-decoration: none;\n}\n/*}}}*/\n

akkartik

adjList converts a list into a list of adjacent pairs of elements.\n{{code{\nmain = do\n  word:_ <- liftM words getContents\n  print $ adjList word}}}\n{{test{\n{{prompt{$}}} ghc --make countPaths.hs; echo "ABA" |./a.out}}}\n{{output{\n[('A','B'),('B','A')]}}}\nPretty easy to implement:\n{{code{\nadjList word = zip word $ tail word}}}\n{{comment{Notice that the following are all equivalent:\n{{code{\nzip word (tail word)\nzip word $ tail word\n(zip word . tail) word\n}}}\nThey aren't all equally readable, though. I currently have a certain distrust for too much function composition. Especially if you're applying a complex function expression to arg, but the expression also uses arg.}}}\n

http://www.cs.utexas.edu/~akkartik

assocs, when applied to an array, returns a list of the associations in index order.

The bounds function applied to an array returns its bounds.\n\n> Input: bounds (array (0,3) [(1,"A"),(2,"B"),(3,"D"),(0,"QQQ")])\n> Output: (0,3)\n\nhttp://www.zvon.org/other/haskell/Outputarray/bounds_f.html

''combineMaps'' takes a list generated by [[listAllNeighbors]] where each element is of this form:\n  (('A', 'B'), Map (1,1) [(1,2)])\n..and so on. This element says, for example, that if you want to go from A to B and you are currently at (1,1), one option before you is to go to (1,2) and you shall find B there.\n\nBefore combineMaps, each list within each Map currently has just one element. combineMaps merges the options in all the scenarios.\n\nSo we're combining all the maps corresponding to each pair of characters, and within each map we concatenate all the lists corresponding to a given coordinate.\n\n{{code{\n''combineMaps'' = [[M.fromListWith]] ([[M.unionWith]] (flip (++)))\n}}}

A problem and a terse solution in haskell: [[count the ways to find a word by walking a 2D grid|http://blog.moertel.com/articles/2006/08/15/solving-the-google-code-jam-countpaths-problem-in-haskell]]. Join me as I try to decipher it with [[Tom Moertel|http://blog.moertel.com]] watching over my shoulder along the way and helpfully explaining things when I get stuck. (You might want to skim [[that article|http://blog.moertel.com/articles/2006/08/15/solving-the-google-code-jam-countpaths-problem-in-haskell]] first.)\n\nThe goal is the following. Given two arguments:\n* a string ''word'', and\n* a 2D character ''grid''\n..determine the number of distinct paths through the grid that form ''word''.\nYou can use the same point on the grid multiple times, but not consecutively.\n\nLet's start by trying it out. The first line of input is ''word'', the rest is the ''grid'' until the ^D.\n{{test{\n{{prompt{$}}} ghc --make [[countPaths.hs]]; ./a.out\nAB\nABCD\nEFGH\n^D}}}\nThe output?\n{{output{\n1}}}\ni.e. there's just one path from A to B in the above grid.\n\nAnother trial run:\n{{test{\n{{prompt{$}}} ./a.out \nAA\nAAAA\nAAAA\n}}}\n{{output{\n32}}}\ni.e. there are 32 ways to trace AA in the above grid of all As.\n\nSo how does it work? Looking at main:\n{{code{\nmain = do\n    {{comment{-- read array of words from stdin, first element into word, rest into gridspec list}}}\n    word:gridspec <- liftM words getContents\n    print $ (''countPaths'' word ([[toGridArray]] gridspec) :: Integer)}}}\n\n..brings us immediately to ''countPaths''.\n{{code{\n''countPaths'' word@(p:_) gridArray =\n    sum . M.elems $ foldl step state0 $ zip word $ tail word\n{{comment{  where\n    state0 = M.fromList [(cell, 1) | (cell, q) <- assocs gridArray, p == q]\n    step state fromto = M.fromListWith (+) $ do\n        steps <- M.lookup fromto $ toNeighborMap gridArray\n        (start, count) <- M.assocs state\n        cells <- M.lookup start steps\n        cell <- cells\n        return (cell, count)}}}\n}}}\nThat's a mouthful. Focus on the top-level implementation. Replacing pieces of it with more descriptive names, we get:\n{{code{\ncountPaths word gridArray =\n    [[sumMapValues]] [[partialPathCounts]]\n{{comment{  where..}}}}}}\n[[partialPathCounts]] returns a 'state' map\n  Map (r, c) => count\nthat is the result of tracing paths starting with all the initial possibilities in the [[state0]] map and ending at different cells (r, c) (all containing the last character of ''word'')\n\n[[sumMapValues]] then adds up all the values in the map together.\n

Here's the baseline code to run. I change/override different parts of it as I probe into its inner workings.\n\n{{{\nmodule Main (main) where\n\nimport Control.Monad \nimport Data.Array\nimport qualified Data.Map as M\n\nmain = do\n word:gridspec <- liftM words getContents\n print $ (countPaths word (toGridArray gridspec) :: Integer)\n\ntoGridArray gridspec@(l1:_) =\n listArray ((1,1), (length gridspec, length l1)) (concat gridspec)\n\ncountPaths word@(p:_) gridArray =\n sum . M.elems $ foldl step state0 (zip word (tail word))\n where \n state0 = M.fromList [(cell, 1) | (cell, q) <- assocs gridArray, p == q]\n neighbors = toNeighborMap gridArray\n step state fromto = M.fromListWith (+) $ do\n steps <- M.lookup fromto neighbors\n (start, count) <- M.assocs state\n cells <- M.lookup start steps\n cell <- cells\n return (cell, count)\n\ntoNeighborMap gridArray =\n combineMapLists $ listAllNeighbors gridArray\n\nlistAllNeighbors gridArray = do\n (cell, p) <- assocs gridArray\n cell' <- neighbors8 cell\n guard $ inRange (bounds gridArray) cell'\n return ((p, gridArray!cell'), M.singleton cell [cell'])\n\ncombineMapLists = M.fromListWith (M.unionWith (flip (++)))\n\nneighbors8 (r,c) =\n [(r+h, c+v) | h <- [-1..1], v <- [-1..1], h /= 0 || v /= 0]\n}}}

guard p returns () if p is True, otherwise mzero; it can be used as follows:\n\n> myDiv :: Fractional a => a -> a -> Maybe a\n> myDiv x y = \n>    do\n>        guard (y /= 0)\n>        return (x / y)\n>\n> When y == 0, The function returns Nothing, otherwise Just (x / y).\n\nhttp://members.chello.nl/hjgtuyl/tourdemonad.html#guard

The monadic lifting operators promote a function to a monad.\nThe function arguments are scanned left to right. For example:\n\n> liftM2 (+) [0,1] [0,2] = [0,2,1,3]\n> liftM2 (+) (Just 1) Nothing = Nothing\n\nhttp://www.cse.ogi.edu/~hallgren/Programatica/tools/pfe.cgi?Control.Monad

''listAllNeighbors'' uses gridArray to generate all possible neighbor relationships between points in the grid. It generates them in a format that we can then combine together to obtain the neighborMap: a list of Maps, each with one singleton list element.\n\nTry it out:\n{{code{\nmain = do\n    gridspec <- liftM words getContents\n    print $ listAllNeighbors $ toGridArray gridspec}}}\nTrial run:\n{{test{\n{{prompt{$}}} ghc countPaths.hs; ./a.out\nAB\nBA\n}}}\nOutput (with indentation for clarity):\n{{output{\n[\n  (('A','B'), {(1,1):=[(1,2)]}),\n  (('A','B'), {(1,1):=[(2,1)]}),\n  (('A','A'), {(1,1):=[(2,2)]}),\n  (('B','A'), {(1,2):=[(1,1)]}),\n  ..\n]\n}}}\n\nSo how does it work?\n{{code{\n''listAllNeighbors'' = do\n    (cell, p) <- [[assocs]] gridArray\n    ngh <- [[neighbors8]] cell\n    [[guard]] $ [[inRange]] ([[bounds]] gridArray) ngh\n    return ((p, gridArray!ngh), [[M.singleton]] cell [ngh])}}}\nNot very clear. To break this down I'm going to peek inside step by step to see what happens. Assuming the above trial run, what is gridArray?\n{{code{\nmain = do\n    gridspec <- [[liftM]] words getContents\n    print $ [[toGridArray]] gridspec\n}}}\n{{output{\narray ((1,1),(2,2)) [((1,1),'A'),((1,2),'B'),((2,1),'B'),((2,2),'A')]}}}\n(I'm not showing compile-and-run from now on, but we're still doing it everytime.)\n\nNow, let's step through ''listAllNeighbors'':\n{{code{\n{{comment{main = do\n    gridspec <- [[liftM]] words getContents\n    print $ listAllNeighbors $ [[toGridArray]] gridspec\n\n''listAllNeighbors'' = do}}}\n    (cell, p) <- [[assocs]] gridArray\n    return (cell, p)\n}}}\n{{output{\n[((1,1),'A'),((1,2),'B'),((2,1),'B'),((2,2),'A')]}}}\nOk, we've picked the second part of the array.\n\nWhat's cell?\n{{code{\n{{comment{''listAllNeighbors'' = do\n    (cell, p) <- [[assocs]] gridArray}}}\n    return cell\n}}}\n{{output{\n[(1,1),(1,2),(2,1),(2,2)]}}}\nHmm, there's something magical going on here. The ''p'' corresponds to the character in every element. How is listAllNeighbors executing in 'Array context'?\n<<<\n{{comment{\n[[Tom Moertel|http://blog.moertel.com]]:\nRemoving the do-notation's syntactic sugar, the expression is really this:\n{{code{\nassocs gridArray >>=\n\s(cell, p) -> return cell}}}\nAnd in the list monad,\n{{code{\n(>>=) = concatMap\nreturn x = [x]}}}\nthus the expression simplifies to the following:\n{{code{\nconcatMap (\s(cell, p) -> [cell]) (assocs gridArray)}}}\nwhich evaluates to a list containing the indices of the gridArray..}}}\n<<<\nNext line:\n{{code{\n{{comment{''listAllNeighbors'' = do\n    (cell, p) <- [[assocs]] gridArray}}}\n    ngh <- [[neighbors8]] cell\n    return ngh\n}}}\n{{output{\n[(0,0),(0,1),(0,2),(1,0),(1,2),(2,0),..,(2,1),(2,3),(3,1),(3,2),(3,3)]\n}}}\nWhat's going on here? Go look at [[neighbors8]]. What it's doing is generating the 8 nearest neighbors for every coordinate. So combining nearest neighbors for all 4 cell coordinates in (1..2,1..2) gives us (0..3,0..3).\n\nThe whole 'array context' gets even weirder because now it seems the return executes more often than the statement above it. Looking at the two successive '<-'s my hypothesis is that when the rhs is an array the rest of the do body implicitly iterates through it with the inductive variable as the lhs.\n<<<\n{{comment{\n[[Tom Moertel|http://blog.moertel.com]]:\nBecause of the definition of bind (>==) in the list monad, successive bind\noperations have an effect similar to that of nested loops in imperative\nprogramming languages:\n{{code{\ndo { x <- [1..3]; y <- [4..6]; return (x,y) }\n}}}\n{{output{\n[(1,4),(1,5),(1,6),(2,4),(2,5),(2,6),(3,4),(3,5),(3,6)]}}}}}}\n<<<\nMoving right along.. Some of those coordinates are illegal, so the next statement removes them:\n{{code{\n{{comment{''listAllNeighbors'' = do\n    (cell, p) <- [[assocs]] gridArray\n    ngh <- [[neighbors8]] cell}}}\n    [[guard]] $ [[inRange]] ([[bounds]] gridArray) ngh\n    return ngh\n}}}\n{{output{\n[(1,2),(2,1),(2,2),(1,1),(2,1),(2,2),(1,1),(1,2),(2,2),(1,1),(1,2),(2,1)]\n}}}\nWe're back in legal coordinates, but it doesn't make too much sense. But hold on, what are the other variables in each case?\n\n{{code{\n{{comment{''listAllNeighbors'' = do\n    (cell, p) <- [[assocs]] gridArray\n    ngh <- [[neighbors8]] cell\n    [[guard]] $ [[inRange]] ([[bounds]] gridArray) ngh}}}\n    return (cell, p, ngh)\n}}}\n{{output{\n[((1,1),'A',(1,2)),((1,1),'A',(2,1)),((1,1),'A',(2,2)),((1,2),'B',(1,1)),((1,2),'B',(2,1)),..]\n}}}\nStill not too clear, but now the last line makes sense:\n{{code{\n    return ((p, gridArray!ngh), [[M.singleton]] cell [ngh])\n}}}\n''cell'' is the current node, ''ngh'' is one of its legal neighbors. The element at ngh is ''gridArray!ngh''. So what this does is to convert\n{{{((1,1), 'A', (1,2))}}}\nto {{{(('A', gridArray(1,2)), (Map (1,1) => [(1, 2)])}}}\nand thence to {{{(('A', 'B'), (Map (1, 1) := [(1, 2)]))}}}\nwhich is in the form we want in [[combineMapLists]]. To summarize, it means: if you want to go from A to B and you're at (1,1) one option before you is to step to (1,2) next.\n\nNotice the redundancy in this format? If you're at (1,1) of course you want to go from A. But indexing an Array can only happen in a special do form because of haskell's type system. It's starting to look like a lot of the skill in programming haskell is coming up with these intermediate representations that are easy to process in the next stage of the pipeline.\n

Returns a list of the coordinates around (r, c).\n{{code{\n''neighbors8'' (r,c) =\n    [(r+h, c+v) | h <- [-1..1], v <- [-1..1], h /= 0 || v /= 0]}}}

''partialPathCounts'' is an intermediate map that contains, for every cell in gridArray after consuming ''word'', the number of paths that end at that cell. Try it out:\n{{code{\nmain = do\n    word:gridspec <- liftM words getContents\n    print $ countPaths word $ toGridArray gridspec\n\ncountPaths word gridArray = ''partialPathCounts''\n{{comment{  where..}}}}}}\n{{test{\n{{prompt{$}}} ghc countPaths.hs; ./a.out\nAB\nAB\nBA\n}}}\n{{output{\n{(1,2):=2,(2,1):=2}\n}}}\ni.e. there's two paths to get AB that end at (1,2) and another two that end at (2, 1).\n\nHow does it work?\n{{code{\n{{comment{countPaths word@(p:_) gridArray =\n    [[sumMapValues]] ''partialPathCounts''\n  where}}}\n    ''partialPathCounts'' = foldl [[step]] [[state0]] $ [[adjList]] word\n    ..}}}\n[[adjList]] breaks the word up into a sequence of adjacent pairs of characters.\n[[state0]] contains an initial map of path counts.\n[[step]] describes how to update the map for a given pair of characters.\n\nSo the foldl applies a sequence of adjacent character pairs to an initial map and returns a final map that contains the right counts for each cell.

A map that contains a 1 for every cell in the grid that has the first character of ''word''.\n{{code{\n{{comment{countPaths word@(p:_) gridArray =\n    ..\n  where\n    ..}}}\n    ''state0'' = M.fromList [(cell, 1) | (cell, q) <- assocs gridArray, p == q]}}}\n\n

What does ''step'' do? We know that [[partialPathCounts]] returns for each cell the number of paths that end at that cell. ''step'' does one increment in that process. Let's try to visualize the increments:\n\n{{code{\ncountPaths word@(p:_) gridArray = [[state0]]}}}\n{{test{\n{{prompt{$}}} ghc --make countPaths.hs; ./a.out\nABAB\nAB\nBA}}}\n{{output{\n{(1,1):=1,(2,2):=1}\n}}}\nAs we've seen [[before|state0]], the number of possible places to start pattern ABAB in the grid, each currently at 1.\n\nAfter one iteration (A consumed):\n{{code{\ncountPaths word@(p:_) gridArray = \n  ''step'' state0 $ head $ adjList word}}}\n{{output{\n{(1,2):=2,(2,1):=2}\n}}}\n\nAfter two iterations (AB consumed):\n{{code{\ncountPaths word@(p:_) gridArray = \n  foldl ''step'' state0 $ take 2 $ adjList word}}}\n{{output{\n{(1,1):=4,(2,2):=4}\n}}}\n\nSo it consumes one link (say ('A', 'B')) and replicates the count for every coordinate in the map (all of which by definition contain 'A') into adjacent cells containing a 'B'. Time to see how it does this:\n{{code{\n{{comment{''countPaths'' word@(p:_) gridArray =\n    ...\n  where\n    ...}}}\n    step state fromto = [[M.fromListWith]] (+) $ do\n        steps <- M.lookup fromto $ [[toNeighborMap]] gridArray\n        (start, count) <- M.assocs state\n        cells <- M.lookup start steps\n        end <- cells\n        return (end, count)\n}}}\n\n[[toNeighborMap]] is a 2-D 'neighbor map' where you can lookup ('A','B') then (1,1) to find a list of adjacent coordinates containing a 'B' cell to copy your count into.\n\nOnce we know how [[toNeighborMap]] works (and have thus exercised our fluency with haskell do notation) this is pretty clear.\n* For every coordinate in the neighbor map corresponding to ('A', 'B'), extract the secondary map into ''steps''\n* For every key-value pair (start, count) in ''state'' [start is a coordinate]\n* For every coordinate ''end'' in steps[start]\n* Create an entry (end, count)\nThe lack of indentation takes some getting used to, and the recomposing together is entirely transparent, first into list of pairs, then into a new state map by adding together counts for the same coordinate.

sumMapValues = sum . M.elems

toGridArray converts a 2D list of chars (list of strings) into a haskell Array.\n\n{{code{\n''toGridArray'' gridspec@(l1:_) =\n    listArray ((1,1), (length gridspec, length l1)) (concat gridspec)}}}\n\nTry it out:\n{{code{\nmain = do\n    word:gridspec <- [[liftM]] words getContents\n    print $ toGridArray gridspec}}}\n\nTrial run:\n{{test{\n{{prompt{$}}} ghc --make [[countPaths.hs]]; ./a.out\nAAAA\nAAAA\n}}}\n{{output{\narray ((1,1),(1,4)) [((1,1),'A'),((1,2),'A'),((1,3),'A'),((1,4),'A')] \n}}}\n

''toNeighborMap'' works as follows: For a given gridArray, it generates a 2D map\n    Map { (A, B) => Map { (r, c) => [(r2, c2)*] } }\nthat you can use to answer the question, "If I'm at (r, c) and need a B next, what are my options?"\n\nTry it out:\n{{code{\nmain = do\n    gridspec <- liftM words getContents\n    print $ toNeighborMap $ toGridArray gridspec\n}}}\n\nTrial run:\n{{test{\n{{prompt{$}}} ghc --make countPaths.hs; ./a.out\nAB\nBA\n}}}\nOutput (with indentation for clarity):\n{{output{\n{\n  ('A','A'):={\n    (1,1) := [(2,2)],\n    (2,2) := [(1,1)]\n  },\n  ('A','B'):={\n    (1,1) := [(1,2), (2,1)],\n    (2,2) := [(1,2), (2,1)]\n  },\n  ..\n}\n}}}\n\nSo how does it work?\n\n{{code{\n''toNeighborMap'' gridArray = [[combineMapLists]] $ [[listAllNeighbors]] gridArray}}}\n