Fast Boggle solver. Based on my previous Boggle gist, but now with more bitsets, multicore and hackish chunking. Currently it takes around 15 ms file reading included with the TWL06 word list, an i7 3770 and the -N4 flag.

FastBoggle.hs

import qualified Data.Vector as V
import qualified Data.Vector.Unboxed as UV
import qualified Data.ByteString.Char8 as B

import Data.Ix
import Text.Printf
import Data.List
import Data.Ord
import System.Environment
import Data.Bits
import Control.Parallel.Strategies

import Criterion.Main

neighbors :: V.Vector [Int]
neighbors = V.fromList [[4*i + j |
        (i,j) <- range ((x-1, y-1), (x+1, y+1)),
        inRange ((0, 0), (3, 3)) (i,j),
        (i,j) /= (x, y)] | 
        (x, y) <- range ((0, 0), (3, 3))]

-- chunking the dictionary on newlines to avoid slicing into words (and avoid using slow Haskell list chunking)
nChunks :: Int -> B.ByteString -> [B.ByteString]
nChunks n bs = let
    len  = B.length bs
    size = div len n 
    is   = takeWhile (<len) $ [size, 2*size ..]
    adjust = until ((=='\n') . B.index bs) pred
    is' = 0 : map adjust is ++ [len]
    slices = zip is' (tail is')
    in [B.take (b - a) (B.drop a bs) | (a, b) <- slices] 

finds :: UV.Vector Char -> B.ByteString -> [B.ByteString]
finds table inp = let
    dicts = nChunks 4 inp

    go [] bs = False
    go paths bs | B.null bs = True 
    go paths bs = go paths' (B.tail bs) where
        paths' = [(n, setBit visited n) |
            (i, visited) <- paths,
            B.head bs == table `UV.unsafeIndex` i,
            n <- neighbors `V.unsafeIndex` i,
            not $ testBit visited n]
    start = [(i, setBit 0 i :: Int) | i <- [0..15]]

    in concat $ parMap rdeepseq (filter (\w -> B.length w > 2 && go start w) . B.lines) dicts

main :: IO ()
main = do
    args <- getArgs
    case args of
        [dictFile, tableSpec] -> do 
            dict <- B.readFile dictFile
            let table = UV.fromList tableSpec
                found = sortBy (flip $ comparing B.length) (finds table dict)
            printf "\n%d finds:\n%s" (length found) (show found)
        _ -> putStrLn "usage: Boggle [dictFile] [table]"


------ for benchmarking
--main = do
--    defaultMain [
--        bench "bench" $ nfIO $ (finds (UV.fromList "ABCDEFGHIJKLMNOP")) `fmap` B.readFile "words.txt"]