    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 =
          [a] -> [a] -> [Int] -> [Int] -> [Int]
    forall {a} {a}.
    (Num a, Ord a, Eq a) =>
    [a] -> [a] -> [a] -> [a] -> [a]
    oneDiag [a]
    a [a]
    b ([[Int]] -> [Int]
    forall a. HasCallStack => [a] -> a
    head [[Int]]
    uppers) (-Int
    1 Int -> [Int] -> [Int]
    forall a. a -> [a] -> [a]
    : [[Int]] -> [Int]
    forall a. HasCallStack => [a] -> a
    head [[Int]]
    lowers)
        uppers :: [[Int]]
    uppers =
          [a] -> [a] -> [[Int]] -> [[Int]]
    forall {a} {a}.
    (Num a, Ord a, Eq a) =>
    [a] -> [a] -> [[a]] -> [[a]]
    eachDiag [a]
    a [a]
    b ([Int]
    mainDiag [Int] -> [[Int]] -> [[Int]]
    forall a. a -> [a] -> [a]
    : [[Int]]
    uppers) -- upper diagonals
        lowers :: [[Int]]
    lowers =
          [a] -> [a] -> [[Int]] -> [[Int]]
    forall {a} {a}.
    (Num a, Ord a, Eq a) =>
    [a] -> [a] -> [[a]] -> [[a]]
    eachDiag [a]
    b [a]
    a ([Int]
    mainDiag [Int] -> [[Int]] -> [[Int]]
    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' a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    bch Bool -> Bool -> Bool
    && a
    ach a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    bch'
              = t
    nw t -> [t] -> [t]
    forall a. a -> [a] -> [a]
    : [a] -> [a] -> t -> [t] -> [t] -> [t]
    doDiag (a
    ach' a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    : [a]
    as) (a
    bch' a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    : [a]
    bs) t
    nw ([t] -> [t]
    forall a. HasCallStack => [a] -> [a]
    tail [t]
    n) ([t] -> [t]
    forall a. HasCallStack => [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 a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    bch then
                    t
    nw
                  else
                    t
    1 t -> t -> t
    forall a. Num a => a -> a -> a
    + t -> t -> t -> t
    forall {a}. Ord a => a -> a -> a -> a
    min3 ([t] -> t
    forall a. HasCallStack => [a] -> a
    head [t]
    w) t
    nw ([t] -> t
    forall a. HasCallStack => [a] -> a
    head [t]
    n)
              in
                t
    me t -> [t] -> [t]
    forall a. a -> [a] -> [a]
    : [a] -> [a] -> t -> [t] -> [t] -> [t]
    doDiag [a]
    as [a]
    bs t
    me ([t] -> [t]
    forall a. HasCallStack => [a] -> [a]
    tail [t]
    n) ([t] -> [t]
    forall a. HasCallStack => [a] -> [a]
    tail [t]
    w)

            firstelt :: a
    firstelt = a
    1 a -> a -> a
    forall a. Num a => a -> a -> a
    + [a] -> a
    forall a. HasCallStack => [a] -> a
    head [a]
    diagBelow
            thisdiag :: [a]
    thisdiag = a
    firstelt a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    : [a] -> [a] -> a -> [a] -> [a] -> [a]
    forall {t} {a}.
    (Num t, Ord t, Eq a) =>
    [a] -> [a] -> t -> [t] -> [t] -> [t]
    doDiag [a]
    a' [a]
    b' a
    firstelt [a]
    diagAbove ([a] -> [a]
    forall a. HasCallStack => [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 = [[a]] -> [a]
    forall a. HasCallStack => [a] -> a
    head ([[a]] -> [[a]]
    forall a. HasCallStack => [a] -> [a]
    tail [[a]]
    diags)
          in
            [a] -> [a] -> [a] -> [a] -> [a]
    forall {a} {a}.
    (Num a, Ord a, Eq a) =>
    [a] -> [a] -> [a] -> [a] -> [a]
    oneDiag [a]
    a' [a]
    bs [a]
    nextDiag [a]
    lastDiag [a] -> [[a]] -> [[a]]
    forall a. a -> [a] -> [a]
    : [a] -> [a] -> [[a]] -> [[a]]
    eachDiag [a]
    a' [a]
    bs [[a]]
    diags

        lab :: Int
    lab =
          [a] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [a]
    a Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - [a] -> Int
    forall a. [a] -> Int
    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 a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    < a
    y then
            a
    x
          else
            a -> a -> a
    forall a. Ord a => a -> a -> a
    min a
    y a
    z

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