Created
June 14, 2013 17:12
-
-
Save ZhanruiLiang/5783637 to your computer and use it in GitHub Desktop.
KMP automaton in Haskell
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
-- module KMPAt where | |
import System.IO | |
import Control.Monad | |
import Data.Maybe | |
import Data.String | |
import System.TimeIt | |
data KMPAt = AuxNode (Maybe KMPAt) | |
| KMPNode (Maybe KMPAt) KMPAt (Char->Bool) | |
-- KMPNode next fail pred | |
instance Show KMPAt where | |
show (AuxNode _) = "AuxNode" | |
show (KMPNode _ _ pred) = "KMPNode " ++ show (filter pred ['a'..'z']) | |
isFinal :: KMPAt -> Bool | |
isFinal (AuxNode _) = False | |
isFinal p = isNothing.nextL $ p | |
nextL (AuxNode n) = n | |
nextL (KMPNode n _ _) = n | |
accSym (AuxNode _) _ = True | |
accSym (KMPNode _ _ predC) c' = predC c' | |
failL p@(AuxNode _) = p | |
failL (KMPNode _ f _) = f | |
match :: KMPAt -> String -> [Int] | |
match root s = runKMP root 0 s where | |
runKMP p i s | isFinal p = i : runKMP (failL p) i s | |
runKMP p i (c:s) = runKMP (fromJust.nextL$ back p c) (i+1) s | |
runKMP _ _ [] = [] | |
back p c | accSym p c = p | |
| otherwise = back (failL p) c | |
buildKMP [] = AuxNode Nothing | |
buildKMP (c:cs) = root where | |
aux = AuxNode (Just root) | |
root = KMPNode (buildKMP' aux cs c) aux (==c) | |
buildKMP' lastFail [] c = Just $ KMPNode Nothing failL' (const False) where | |
failL' = fromJust.nextL $ back (lastFail) c | |
buildKMP' lastFail (c:cs) c' = Just$ KMPNode nextL' failL' (==c) where | |
failL' = fromJust.nextL $ back (lastFail) c' | |
nextL' = buildKMP' failL' cs c | |
collect p | isFinal p = [] | |
| otherwise = (p, failL p) : collect (fromJust.nextL$ p ) | |
match' p s = match (buildKMP p) s | |
-- timeIt f = f | |
main = do | |
(p:ss) <- lines `liftM` hGetContents stdin | |
forM_ ss (putStrLn.reverse.take 10) | |
timeIt $ do | |
putStrLn.unlines.map show$ map (match' p) ss |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment