Word Search Solver

When browsing the Medium homepage I came across this post about #wordsearchwednesday. Although I enjoy a puzzle as much as the next guy, I immediately thought that this was something Haskell lends itself to very well. Less than an hour later I had a working solver. It simply brute-forces the solution by checking every combination with a dictionary. I used the Hunspell dictionaries but anything will do. toSet :: ByteString -> Set ByteString toSet = Set.fromList . B.words . B.map toLower toWords :: ByteString -> [ByteString] toWords s | B.null s = [] | otherwise = B.inits s ++ toWords (B.tail s) solve :: Set ByteString -> [ByteString] -> [ByteString] solve dict strs = filter valid wrds where wrds = foldr ((++) . toWords) [] strs valid w = B.length w > 3 && Set.member w dict main :: IO () main = do (dfile:ifile:_) <- getArgs dictionary <- B.readFile dfile input <- B.readFile ifile let dict = toSet dictionary rows = (B.lines . B.map toLower) input cols = B.transpose rows solutions = solve dict (rows ++ cols) `using` parList rseq putStrLn $ B.unpack $ B.unlines solutions It solved Medium’s letter matrix in 0.07 seconds on my 2014 Macbook Pro. ...

February 13, 2015