module Options.Applicative.Help.Levenshtein (
    editDistance
  ) where

-- | Calculate the Damerau-Levenshtein edit distance
--   between two lists (strings).
--
--   This is modified from
--   https://wiki.haskell.org/Edit_distance
--   and is originally from Lloyd Allison's paper
--   "Lazy Dynamic-Programming can be Eager"
--
--   It's been changed though from Levenshtein to
--   Damerau-Levenshtein, which treats transposition
--   of adjacent characters as one change instead of
--   two.
--
--   Complexity
--     O(|a|*(1 + editDistance a b))
editDistance :: Eq a => [a] -> [a] -> Int
editDistance :: forall a. Eq a => [a] -> [a] -> Int
editDistance [a]
a [a]
b =
  let
    mainDiag :: [Int]
mainDiag =
      forall {a} {a}.
(Num a, Ord a, Eq a) =>
[a] -> [a] -> [a] -> [a] -> [a]
oneDiag [a]
a [a]
b (forall a. [a] -> a
head [[Int]]
uppers) (-Int
1 forall a. a -> [a] -> [a]
: forall a. [a] -> a
head [[Int]]
lowers)
    uppers :: [[Int]]
uppers =
      forall {a} {a}.
(Num a, Ord a, Eq a) =>
[a] -> [a] -> [[a]] -> [[a]]
eachDiag [a]
a [a]
b ([Int]
mainDiag forall a. a -> [a] -> [a]
: [[Int]]
uppers) -- upper diagonals
    lowers :: [[Int]]
lowers =
      forall {a} {a}.
(Num a, Ord a, Eq a) =>
[a] -> [a] -> [[a]] -> [[a]]
eachDiag [a]
b [a]
a ([Int]
mainDiag forall a. a -> [a] -> [a]
: [[Int]]
lowers) -- lower diagonals

    oneDiag :: [a] -> [a] -> [a] -> [a] -> [a]
oneDiag [a]
a' [a]
b' [a]
diagAbove [a]
diagBelow = [a]
thisdiag
      where
        doDiag :: [a] -> [a] -> t -> [t] -> [t] -> [t]
doDiag [] [a]
_ t
_ [t]
_ [t]
_ = []
        doDiag [a]
_ [] t
_ [t]
_ [t]
_ = []
        -- Check for a transposition
        -- We don't add anything to nw here, the next character
        -- will be different however and the transposition
        -- will have an edit distance of 1.
        doDiag (a
ach:a
ach':[a]
as) (a
bch:a
bch':[a]
bs) t
nw [t]
n [t]
w
          | a
ach' forall a. Eq a => a -> a -> Bool
== a
bch Bool -> Bool -> Bool
&& a
ach forall a. Eq a => a -> a -> Bool
== a
bch'
          = t
nw forall a. a -> [a] -> [a]
: [a] -> [a] -> t -> [t] -> [t] -> [t]
doDiag (a
ach' forall a. a -> [a] -> [a]
: [a]
as) (a
bch' forall a. a -> [a] -> [a]
: [a]
bs) t
nw (forall a. [a] -> [a]
tail [t]
n) (forall a. [a] -> [a]
tail [t]
w)
        -- Standard case
        doDiag (a
ach:[a]
as) (a
bch:[a]
bs) t
nw [t]
n [t]
w =
          let
            me :: t
me =
              if a
ach forall a. Eq a => a -> a -> Bool
== a
bch then
                t
nw
              else
                t
1 forall a. Num a => a -> a -> a
+ forall {a}. Ord a => a -> a -> a -> a
min3 (forall a. [a] -> a
head [t]
w) t
nw (forall a. [a] -> a
head [t]
n)
          in
            t
me forall a. a -> [a] -> [a]
: [a] -> [a] -> t -> [t] -> [t] -> [t]
doDiag [a]
as [a]
bs t
me (forall a. [a] -> [a]
tail [t]
n) (forall a. [a] -> [a]
tail [t]
w)

        firstelt :: a
firstelt = a
1 forall a. Num a => a -> a -> a
+ forall a. [a] -> a
head [a]
diagBelow
        thisdiag :: [a]
thisdiag = a
firstelt forall a. a -> [a] -> [a]
: forall {a} {t}.
(Num t, Ord t, Eq a) =>
[a] -> [a] -> t -> [t] -> [t] -> [t]
doDiag [a]
a' [a]
b' a
firstelt [a]
diagAbove (forall a. [a] -> [a]
tail [a]
diagBelow)

    eachDiag :: [a] -> [a] -> [[a]] -> [[a]]
eachDiag [a]
_ [] [[a]]
_ = []
    eachDiag [a]
_ [a]
_ [] = []
    eachDiag [a]
a' (a
_:[a]
bs) ([a]
lastDiag:[[a]]
diags) =
      let
        nextDiag :: [a]
nextDiag = forall a. [a] -> a
head (forall a. [a] -> [a]
tail [[a]]
diags)
      in
        forall {a} {a}.
(Num a, Ord a, Eq a) =>
[a] -> [a] -> [a] -> [a] -> [a]
oneDiag [a]
a' [a]
bs [a]
nextDiag [a]
lastDiag forall a. a -> [a] -> [a]
: [a] -> [a] -> [[a]] -> [[a]]
eachDiag [a]
a' [a]
bs [[a]]
diags

    lab :: Int
lab =
      forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
a forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
b

    min3 :: a -> a -> a -> a
min3 a
x a
y a
z =
      if a
x forall a. Ord a => a -> a -> Bool
< a
y then
        a
x
      else
        forall a. Ord a => a -> a -> a
min a
y a
z

  in
    forall a. [a] -> a
last forall a b. (a -> b) -> a -> b
$
      if Int
lab forall a. Eq a => a -> a -> Bool
== Int
0 then
        [Int]
mainDiag
      else if Int
lab forall a. Ord a => a -> a -> Bool
> Int
0 then
        [[Int]]
lowers forall a. [a] -> Int -> a
!! (Int
lab forall a. Num a => a -> a -> a
- Int
1)
      else
        [[Int]]
uppers forall a. [a] -> Int -> a
!! (-Int
1 forall a. Num a => a -> a -> a
- Int
lab)