Writing a Haskell version of Peter Norvig's spelling corrector is now considered as a standard Haskell exercise. There has been several solutions, of Bryan O'Sullivan, Tim Robinson, or Marco Sero.

curved shell

My solution gives a slightly different perspective. The emphasis is on

  • The list monad
  • Writing type classes
  • Polymorphic functions

The type class and monad ideas are already present in Norvig's code! Indeed, list comprehension in Python is essentially using the monadic structure of lists. The type class (admittedly here completely overkill) simulates the or function in Python.

Finally, the code is written with polymorphic functions. The reason is that there is less possible mistakes when writing such a code. In most of what follows, the code works not only for strings, but for lists of any type.

The code is on GitHub.

Design choices

Some comments about some design choices. First, I don't think that sets are necessary here. Everything is much simpler with lists, although we'll have to carry around duplicates. This is a price to pay, the alternative being the costly procedure of eliminating all duplicates.

The other choice is to use the module Data.Text instead of Data.ByteString, as this seems to be more suitable for, well, text. This is only relevant in the construction of the dictionary, as the rest of the code, being polymorphic, has nothing to do with strings.

The code

At this point, you should take another look at Norvig's Python implementation, to understand the basic principle of how this all works.

The editors

First, prepare all the “editors”:

transpose :: [a] -> [a]
transpose [] = []
transpose [_] = []
transpose (a:b:xs) = b:a:xs

delete :: [a] -> [a]
delete [] = []
delete (_:xs) = xs

insert :: [a] -> [a] -> [[a]]
insert letters word = 
    do -- List
      l <- letters
      return (l:word)

replace :: [a] -> [a] -> [[a]]
replace _ [] = []
replace letters (_:xs) = insert letters xs

Gather all the editors

allEditors :: [a] -> [[a] -> [[a]]]
allEditors letters =  [return . transpose, replace letters, return . delete, insert letters]

Gather all the possible editing (one edit)

We need to define all the possible splits of a word:

splits :: [a] -> [([a],[a])]
splits word = zip (inits word) (tails word)

Note how this method avoids using splitAt and a length calculation, which is error-prone.

Finally, we can define the editOnce function:

editsOnceWith :: [[a]->[[a]]] -> [a] -> [[a]]
editsOnceWith editors word = do -- List
    (begin,end) <- splits word
    editor <- editors
    endedit <- editor end
    return (begin ++ endedit)

I really like the do notation for the list monad, but you could also write it in a big list comprehension:

[begin ++ endedit |
    (begin,end) <- splits word,
    editor <- editors,
    endedit <- editor end]

Read from the dictionary of known words

We are now ready to gather all the known elements from the dictionary of known words:

inDict :: (Eq k, Ord k) => M.Map k v -> [k] -> [(k,v)]
inDict dict = mapMaybe myLookup
    where
      myLookup w = -- returns either Nothing or Just (w,f) if w is found in dict (f is the frequency)
        do -- Maybe
          f <- M.lookup w dict
          return (w,f)

Python's or function

Before building the list of known edited words, we implement a Haskell version of Python's or function.

We need to define what it means to be “Bool-like”:

class BoolLike a where
    falthy :: a -> Bool
    bempty :: a

We are going to use that a list is “truthy“ if it is not empty:

instance BoolLike [a] where
    bempty = []
    falthy = null

Now we define a monoid structure which selects the first truthy element:

newtype First a = MkFirst { getFirst :: a } deriving (Show, Eq)

instance BoolLike a => Monoid (First a) where
    mempty = MkFirst bempty
    mappend (MkFirst l) (MkFirst r) = MkFirst (if falthy l then r else l)

List monadic composition

Notice how editOnce has (essentially) the type signature

[a] -> [[a]]

It means that in order to edit a word twice, we need to compose that function with itself. This is a textbook example of a monadic composition (here with the list monad). Monadic (or Kleisli) composition is obtained with (<=<) in the following code snippet.

Minimal number of edits to get some known words

We now use the First monoid structure to select the first group of known words which is not empty:

allChoices :: ([a] -> [(a,b)]) -> (a -> [a]) -> a -> [(a,b)]
allChoices inDict' edits1 word = getFirst possibilities
  where
    possibilities = 
      mkFirst return
      <>  mkFirst edits1 
      <>  mkFirst (edits1 <=< edits1) 
    mkFirst edit = (MkFirst . inDict' . edit) word

Choose the best candidate

In order to choose the best candidate, we need a function which is not in the Haskell library, so we implement it! It is simply a variant of maximumBy which works on empty lists as well. In order to work, such a function needs a default value. The implementation is straightforward:

maxByOrDefault :: (Foldable t) => (a -> a -> Ordering) -> a -> t a -> a
maxByOrDefault comp = foldl' (\ e e' -> if comp e' e == GT then e' else e)

And we now choose the best of all the candidates:

chooseBest :: (Ord k, Ord v, Num v) => k -> [(k,v)] -> k
chooseBest nothing choices' = fst bestPair
    where bestPair = maxByOrDefault (comparing snd) (nothing, 0) choices'

Piecing all together

piecing together

Piecing all together (and specializing to the case of strings) is now very simple:

alphabet :: String
alphabet = ['a' .. 'z']


correct :: TrainingDict -> String -> String -> String
correct dict notfound word = chooseBest notfound choices
  where
    choices = allChoices (inDict dict) (editsOnceWith (allEditors alphabet)) word

The training dictionary

We need to creating a big hash map from a text file. I have hardly changed anything from the original code except that I use Text.unpack and Data.Text.IO.readfile to read the file (ByteString does not sound like such a good idea).

nWords :: IO TrainingDict
nWords = do -- IO
  fileName <- getDataFileName "big.txt"
  ws <- readFile fileName
  return ((train . lowerWords . unpack) ws)

lowerWords :: String -> [String]
lowerWords = words . fmap normalize
  where normalize c = if isAlpha c then toLower c else ' '

train :: (Ord k, Num v) => [k] -> M.Map k v
train trainWords = foldl' increment M.empty trainWords
  where
    increment dict x = M.insertWith (+) x 1 dict

Things to do

One remaining thing to do is to write proper tests, using a dummy dictionary.


Edit: The code now follows the excellent readability advice of Gabriel Gonzalez.

Say thanks!