1module Options.Applicative.Help.Levenshtein (
2    editDistance
3  ) where
4
5-- | Calculate the Damerau-Levenshtein edit distance
6--   between two lists (strings).
7--
8--   This is modified from
9--   https://wiki.haskell.org/Edit_distance
10--   and is originally from Lloyd Allison's paper
11--   "Lazy Dynamic-Programming can be Eager"
12--
13--   It's been changed though from Levenshtein to
14--   Damerau-Levenshtein, which treats transposition
15--   of adjacent characters as one change instead of
16--   two.
17editDistance :: Eq a => [a] -> [a] -> Int
18editDistance a b = last $
19  case () of
20    _ | lab == 0
21     -> mainDiag
22      | lab > 0
23     -> lowers !! (lab - 1)
24      | otherwise
25     -> uppers !! (-1 - lab)
26  where
27    mainDiag = oneDiag a b (head uppers) (-1 : head lowers)
28    uppers = eachDiag a b (mainDiag : uppers) -- upper diagonals
29    lowers = eachDiag b a (mainDiag : lowers) -- lower diagonals
30    eachDiag _ [] _ = []
31    eachDiag _ _ [] = []
32    eachDiag a' (_:bs) (lastDiag:diags) =
33      oneDiag a' bs nextDiag lastDiag : eachDiag a' bs diags
34      where
35        nextDiag = head (tail diags)
36    oneDiag a' b' diagAbove diagBelow = thisdiag
37      where
38        doDiag [] _ _ _ _ = []
39        doDiag _ [] _ _ _ = []
40        -- Check for a transposition
41        -- We don't add anything to nw here, the next character
42        -- will be different however and the transposition
43        -- will have an edit distance of 1.
44        doDiag (ach:ach':as) (bch:bch':bs) nw n w
45          | ach' == bch && ach == bch'
46          = nw : doDiag (ach' : as) (bch' : bs) nw (tail n) (tail w)
47        -- Standard case
48        doDiag (ach:as) (bch:bs) nw n w =
49          me : doDiag as bs me (tail n) (tail w)
50          where
51            me =
52              if ach == bch
53                then nw
54                else 1 + min3 (head w) nw (head n)
55        firstelt = 1 + head diagBelow
56        thisdiag = firstelt : doDiag a' b' firstelt diagAbove (tail diagBelow)
57    lab = length a - length b
58    min3 x y z =
59      if x < y
60        then x
61        else min y z
62