Just some remarks:
difference = length . filter (==False) . uncurry (zipWith (==))
Maybe difference = length . filter id . uncurry (zipWith (/=)) or even difference w = length . filter id . zipWith (/=) w and defer the call of uncurry. We then have keepOneDiff = filter ((< 2) . uncurry difference) [Clearly the last version has a point...] But once having done this, we see, that we construct the pair in listPairs and deconstruct it in keepOneDiff. While this is perfectly valid (and good practice to separate the concerns), in the concrete setting one could write wanted ws = [ (w,v) | (w:vs) <- tails ws, v <- vs, difference w v < 2 ] and thus only create the pairs when necessary. Moreover, we only calculate the difference to check whether it is smaller than 2. We can do this directly (capturing the common pattern): diff_lt_2 = diff (diff (const . const $ False)) diff _ [] [] = True diff f (x:xs) (y:ys) = if x == y then diff f xs ys else f xs ys diff _ _ _ = error "length xs /= length ys!?" We now have wanted ws = [ (w,v) | (w:vs) <- tails ws, v <- vs, diff_lt_2 w v ] This modification boosts performance a lot, for example fingerspell 15 100 runs in 5.5 instead of 53 secs on my machine. A last remark:
requirements w = length w == wl && all (isAlpha) w
traverses w twice (although length does'nt touch the elements). One could do this in one pass along the lines req [] [] = True req (_:ys) (x:xs) | isAlpha x = req ys xs req _ _ = False requirements = req (replicate wl undefined) Unfortunately this is slower, I guess it has something to do with the use of the strict foldl' for length and with the fact that in /usr/shar/dict/words there seems to be only words for which all isAlpha returns True. A very last sentence: The req given above is just an instance of an even more general diff, so I finally reached the following: import Data.List (tails) import Data.Char (isAlpha) import Control.Monad (liftM) fingerspell wl p = let okay = diff_eq_0 (replicate wl True) . map isAlpha -- | faster in the concrete setting but not in general!? -- let okay w = length w == wl && all isAlpha w in liftM words (readFile "/usr/share/dict/words") >>= mapM_ putStrLn . take p . wanted . filter okay -- difference w = length . filter id . zipWith (/=) w -- diff_le_1 w v == difference w v < 2 wanted ws = [ w++", "++v | (w:vs) <- tails ws, v <- vs, diff_le_1 w v ] where diff_le_1 = diff (error "length w /= length v") diff_eq_0 diff g f (x:xs) (y:ys) | x == y = diff g f xs ys | otherwise = f xs ys diff g _ xs ys = g xs ys diff_eq_0 :: Eq a => [a] -> [a] -> Bool diff_eq_0 = diff (\ u v -> null u && null v) (const . const $ False) /BR -- -- Mirko Rahn -- Tel +49-721 608 7504 -- --- http://liinwww.ira.uka.de/~rahn/ ---