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.
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", "RLJCINU", "AAWAAHR", "NTKLPNE", "CILFSAP", "EOGOTPN", "HPOLAND"] main :: IO () main = mapM_ (putStrLn . findWord (toGrid puzzle)) $ words "ITALY HOLLAND POLAND SPAIN FRANCE JAPAN TOGO PERU"
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.