Write a little guyHEADmain

This program is in a weird state right now, but I'm checking it in to
git so that I can back it up, since I want to reinstall again.

1 files changed, 27 insertions, 0 deletions

diff --git a/EditDistance.hs b/EditDistance.hs
new file mode 100644
index 0000000..124d968
--- /dev/null
+++ b/EditDistance.hs
@@ -0,0 +1,27 @@
+{-# LANGUAGE FlexibleContexts #-}
+module EditDistance (dist) where
+
+import qualified Data.Sequence as Sequence
+import qualified Data.Map as Map
+import qualified Control.Monad.State as State
+
+dist :: Eq a => [a] -> [a] -> Int
+dist a b = State.evalState (d (pred $ length aSeq) . pred $ length bSeq) Map.empty
+  where d :: Int -> Int -> State.State (Map.Map (Int, Int) Int) Int
+        d i (-1) = return (succ i)
+        d (-1) j = return (succ j)
+        d i j = do m <- State.get
+                   case Map.lookup (i, j) m of
+                     Just res -> return res
+                     Nothing
+                       | aSeq `Sequence.index` i == bSeq `Sequence.index` j -> do res <- d (pred i) (pred j)
+                                                                                  State.modify (Map.insert (i, j) res)
+                                                                                  return res
+                       | otherwise -> do left <- succ <$> d (pred i) j
+                                         right <- succ <$> d i (pred j)
+                                         middle <- succ <$> d (pred i) (pred j)
+                                         let res = min (min left right) middle
+                                         State.modify (Map.insert (i, j) res)
+                                         return res
+        aSeq = Sequence.fromList a
+        bSeq = Sequence.fromList b