Posts Tagged ‘solver’

Programming Praxis – Word Search Solver

May 26, 2009

Today‚Äôs Programming Praxis problem is about word search solvers. The provided solution is 77 lines, so let’s see if we can improve on that.

Our imports:

import Data.List
import Data.Map (Map, fromList, member, keys, (!))
import Text.Printf

First let’s define the 8 directions that we can search in. The puzzle is going to be represented as a Map with a tuple of Ints as the key, so the directions are functions for transforming these keys.

dirs :: [(String, (Int, Int) -> (Int, Int))]
dirs = zip ["down right", "up right", "right", "down left",
            "up left", "left", "down", "up"] $
           [\(x,y) -> (x+h, y+v) | h <- [1,-1,0], v <- [1,-1,0]]

We’re going to enter the puzzle as a list of strings, but since that would make access an O(n2) operation we’re going to turn it into a Map instead, since that gives us O(log n2) access.

toGrid :: [[a]] -> Map (Int, Int) a
toGrid = fromList . concat .
         zipWith (\y -> zipWith (\x c -> ((x,y), c)) [1..]) [1..]

Next we need a function to check whether the search word appears at the given position in the given direction.

found :: (Eq a, Ord k) => k -> (k -> k) -> Map k a -> [a] -> Bool
found pos dir g w = isPrefixOf w . map (g !) .
                    takeWhile (flip member g) $ iterate dir pos

Finding the location and direction of a search word is then simply a matter of checking every direction for every position:

findWord :: Map (Int, Int) Char -> String -> String
findWord g w = head [printf "%s row %d column %d %s" w y x ds |
                     (x,y) <- keys g, (ds, dir) <- dirs,
                     found (x,y) dir g w]

That’s all we need, so let’s test if it works.

puzzle :: [String]
puzzle = ["FYYHNRD",

main :: IO ()
main = mapM_ (putStrLn . findWord (toGrid puzzle)) $ words

And indeed it does, using less than half the lines of the provided solution (almost a third if you ignore the lines required to define the puzzle). That will do nicely.