-- Computes the edit distance between two strings in a naive 
-- (exponential) way and a memoized way.  (Dynamic programming, which 
-- you will learn about in CS 25, is a better way of implementing the 
-- memoization.)

-- based on a program by Michael Fromberger, 11/07
-- modified and extended by Scot Drysdale, 11/18/07

-- The idea is to convert a string s1 into a second string s2 using 
-- the smallest number of edit operations (or in general the smallest 
-- cost series of edit operations).
-- This version of edit distance allows four operations, each of which
-- is charged a cost of one.  (This could be easily modified to have 
-- different costs.)
-- The operations are:
--   1) Insert a character
--   2) Delete a character
--   3) Replace a character
--   4) Swap two characters to match the output.


module EditDistance (
  naiveEditDistance,
  memoEditDistance,
  ) 
where

import qualified Data.Map as Map

-- Straightforward recursive implementation of edit distance.
naiveEditDistance :: String -> String -> Int
naiveEditDistance s1 [] = length s1          -- Delete remainder of s1
naiveEditDistance [] s2 = length s2          -- Insert remainder of s2
naiveEditDistance s1@(x:xs) s2@(y:ys) = minimum
    [ if x == y then matchDist else matchDist + 1,  -- Match or replace
      naiveEditDistance xs s2 + 1,                  -- delete x
      naiveEditDistance s1 ys + 1,                  -- insert y
      swapDist + 1                                  -- swap
    ]
  where matchDist = naiveEditDistance xs ys
        swapDist = if not (null xs) && not (null ys) && 
                      x == head ys && y == head xs 
		           then naiveEditDistance (tail xs) (tail ys)   
		           else matchDist + 5  -- Bigger than another choice


-- Memoized implementation of edit distance; quadratic number of Map 
-- inserts and lookups.
memoEditDistance :: String -> String -> Int
memoEditDistance s1 s2 = dist
  where (dist, mp) = eDist s1 s2 Map.empty
  
  
-- Helper function
-- Note that the map is passed from call to call, being updated on 
-- the way.
eDist         :: String -> String -> Map.Map (String, String) Int -> 
                 (Int, Map.Map (String, String) Int)
eDist s1 [] mp = (length s1, mp)             -- Delete remainder of s1
eDist [] s2 mp = (length s2, mp)             -- Insert remainder of s2
eDist s1@(x:xs) s2@(y:ys) mp = 
  case Map.lookup (s1, s2) mp of
    (Just dist) -> (dist, mp)     -- If already computed this problem, 
                                  -- used saved answer
    Nothing -> 
      let (matchDist, m1) = eDist xs ys mp  -- match and replace cases
          (delDist, m2)   = eDist xs s2 m1
          (insDist, m3)   = eDist s1 ys m2
          (swapDist, m4)  = if not (null xs) && not (null ys) && 
                               x == head ys && y == head xs 
                            then eDist (tail xs) (tail ys) m3  -- swap
                            else (matchDist + 5, m3)
          minDist = minimum [matchDist + (if x == y then 0 else 1),
                             delDist + 1, insDist + 1, swapDist + 1]
      in (minDist, Map.insert (s1, s2) minDist m4 )