5
\$\begingroup\$

I implemented Aho-Corasick string matching in Haskell. It is a purely functional implementation compared to many other implementations.

The input to build an automata is [([a],b)]. which is a list of (pattern,output) pairs. b has to form a monoid, so we know what to do when more than one match occurs at the same place.

I borrowed many idea from the KMP implementation by Twan van Laarhoven(which I suspect is a implementation of the MP instead of KMP algorithm).

import Data.List
import Data.Maybe
import Data.Monoid
import Data.Function
import Control.Arrow
data Automaton a b = Node {delta  :: a -> Automaton a b,
                           output :: b
                         }
-- assume the input function eq is a equivalence relation, then this
-- produce all the equivalent classes.
equivalentClasses :: (a->a->Bool)->[a]->[[a]]
equivalentClasses eq = foldl parts []
  where parts [] a = [[a]]
        parts (x:xs) a 
         | eq (head x) a = (a:x):xs
         | otherwise     = x:parts xs a

buildAutomaton :: (Monoid b,Eq a) => [([a],b)] -> Automaton a b
buildAutomaton xs = automaton
  where automaton = build (const automaton) xs mempty

-- this builds one node of the automaton. Tying the knot happens everywhere
build :: (Monoid b,Eq a)=> (a -> Automaton a b) -> [([a],b)] -> b -> Automaton a b
build trans' xs out = node
  where node  = Node trans out
        trans a
          | isNothing next = trans' a
          | otherwise      = fromJust next
          where next = lookup a table
        table =  map transPair $ equivalentClasses (on (==) (head . fst)) xs
        transPair xs = (a, build (delta (trans' a)) ys out)
         where a  = head $ fst $ head xs
               (ys,zs) = partition (not . null . fst) $ map (first tail) xs
               out = mappend (mconcat $ map snd zs) (output $ trans' a)

-- this function simulates the automaton.
match :: Eq a => Automaton a b -> [a] -> [b]
match a xs = map output $ scanl delta a xs

-- an example to check if a list is a sublist of another list
isInfixOf' :: Eq a => [a] -> [a] -> Bool
isInfixOf' xs ys = getAll $ mconcat $ match (buildAutomaton [(xs, All True)]) ys
\$\endgroup\$
3
\$\begingroup\$

It would be nice if the code was ordered for exposed functions versus internal helpers. It looks like buildAutomaton is the exposed API along with the Automaton data type. However, buildAutomaton is the one function missing any comments or docs.

trans looks a lot like maybe from the Prelude/Data.Maybe.

Use explicit imports to make clear where your functions are coming from.

\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.