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.

The full source code + and example can be found on GitHub