content: {-
      KMP.hs, Knuth-Morris-Pratt string matching algorithm
      Copyright (C) 2011, Liu Xinyu (liuxinyu95@gmail.com)
  
      This program is free software: you can redistribute it and/or modify
      it under the terms of the GNU General Public License as published by
      the Free Software Foundation, either version 3 of the License, or
      (at your option) any later version.
  
      This program is distributed in the hope that it will be useful,
      but WITHOUT ANY WARRANTY; without even the implied warranty of
      MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
      GNU General Public License for more details.
  
      You should have received a copy of the GNU General Public License
      along with this program.  If not, see <http://www.gnu.org/licenses/>.
  -}
  
  module KMP where
  
  import Data.List (isSuffixOf, isPrefixOf, (\\), maximumBy)
  import Data.Function (on)
  import Test.QuickCheck
  
  -- Brute Force KMP
  kmpSearch1 ptn text = kmpSearch' next ([], ptn) ([], text)
  
  kmpSearch' _ (sp, []) (sw, []) = [length sw]
  kmpSearch' _ _ (_, []) = []
  kmpSearch' f (sp, []) (sw, ws) = length sw : kmpSearch' f (f sp []) (sw, ws)
  kmpSearch' f (sp, (p:ps)) (sw, (w:ws))
      | p == w = kmpSearch' f ((p:sp), ps) ((w:sw), ws)
      | otherwise = if sp ==[] then kmpSearch' f (sp, (p:ps)) ((w:sw), ws)
                    else kmpSearch' f (f sp (p:ps)) (sw, (w:ws))
  
  -- Why we said this solution is brute force is because
  --  we provide a brute-force prefix-function
  next sp ps = (sp', ps') where
      prev = reverse sp
      prefix = longest [xs | xs <- inits prev, xs `isSuffixOf` prev]
      sp' = reverse prefix
      ps' = (prev ++ ps) \\ prefix
      longest = maximumBy (compare `on` length)
  
  inits [] = [[]]
  inits [_] = [[]]
  inits (x:xs) = [] : (map (x:) $ inits xs)
  
  -- Improvement 1, 
  failure ([], ys) = ([], ys)
  failure (xs, ys) = fallback (init xs) (last xs:ys) where
      fallback as bs | as `isSuffixOf` xs = (as, bs)
                     | otherwise = fallback (init as) (last as:bs)
  
  kmpSearch2 ws txt = snd $ foldl f (([], ws), []) (zip txt [1..]) where
      f (p@(xs, (y:ys)), ns) (x, n) | x == y = if ys==[] then ((xs++[y], ys), ns++[n])
                                               else ((xs++[y], ys), ns)
                                    | xs == [] = (p, ns)
                                    | otherwise = f (failure p, ns) (x, n)
      f (p, ns) e = f (failure p, ns) e
  
  -- Improvement 2,
  data State a = E | S a (State a) (State a) -- state, ok-state, fail-state
                 deriving (Eq, Show)
  
  build :: (Eq a)=>State ([a], [a]) -> State ([a], [a])
  build (S s@(xs, []) E E) = S s (build (S (failure s) E E)) E
  build (S s@(xs, (y:ys)) E E) = S s l r where
      l = build (S (failure s) E E) -- fail state
      r = build (S (xs++[y], ys) E E)
  
  matched (S (_, []) _ _) = True
  matched _ = False
  
  kmpSearch3 :: (Eq a) => [a] -> [a] -> [Int]
  kmpSearch3 ws txt = snd $ foldl f (auto, []) (zip txt [1..]) where
      auto = build (S ([], ws) E E)
      f (s@(S (xs, ys) l r), ns) (x, n) 
          | [x] `isPrefixOf` ys = if matched r then (r, ns++[n])
                                  else (r, ns)
          | xs == [] = (s, ns)
          | otherwise = f (l, ns) (x, n)
  
  -- Improvement 3,
  --   Remove the failure function completely
  --   suppose fails is a automata which can handle all failure state
  --   This is based on Richard Bird's result [1]
  kmpSearch4 :: (Eq a) => [a] -> [a] -> [Int]
  kmpSearch4 ws txt = snd $ foldl tr (root, []) (zip txt [1..]) where
      root = build' E ([], ws)
      build' fails (xs, []) = S (xs, []) fails E
      build' fails s@(xs, (y:ys)) = S s fails succs where
          succs = build' (fst (tr (fails, []) (y, 0))) (xs++[y], ys)
      tr (E, ns) _ = (root, ns)
      tr ((S (xs, ys) fails succs), ns) (x, n) 
          | [x] `isPrefixOf` ys = if matched succs then (succs, ns++[n]) else (succs, ns)
          | otherwise = tr (fails, ns) (x, n)
  
  
  -- naive search
  naiveSearch ws txt = map length $ filter (ws `isSuffixOf`) (inits txt)
  
  testKMP f = do
    putStrLn $ show $ map (f ws) ts where
           ws = "abababc"
           ts = ["aaabababc", "aaabababcaaa", "ccaaabababababacca", "aaaabababcccaaabababababccaa"]
  
  prop_kmpSearch1 :: [Int] -> [Int] -> Property
  prop_kmpSearch1 as bs = all (not.null) [as, bs] ==> (kmpSearch1 as bs) == (naiveSearch as bs)
  
  -- TODO: test is not completed!!!
  
  --[1] Pearls of Functional algorithm design