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

-- | Calculate the Damerau-Levenshtein edit distance
--   between two lists (strings).
--
--   This is modified from
--   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
--   two.
--
--   Complexity
--     O(|a|*(1 + editDistance a b))
editDistance :: Eq a => [a] -> [a] -> Int
editDistance :: [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. [a] -> a
uppers) (-Int
1 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [[Int]] -> [Int]
forall a. [a] -> a
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] -> a -> [a] -> [a] -> [a]
doDiag [] [a]
_ a
_ [a]
_ [a]
_ = []
doDiag [a]
_ [] a
_ [a]
_ [a]
_ = []
-- 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) a
nw [a]
n [a]
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'
= a
nw a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> a -> [a] -> [a] -> [a]
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) a
nw ([a] -> [a]
forall a. [a] -> [a]
tail [a]
n) ([a] -> [a]
forall a. [a] -> [a]
tail [a]
w)
-- Standard case
doDiag (a
ach:[a]
as) (a
bch:[a]
bs) a
nw [a]
n [a]
w =
let
me :: a
me =
if a
ach a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
bch then
a
nw
else
a
1 a -> a -> a
forall a. Num a => a -> a -> a
+ a -> a -> a -> a
forall a. Ord a => a -> a -> a -> a
min3 ([a] -> a
forall a. [a] -> a
w) a
nw ([a] -> a
forall a. [a] -> a
n)
in
a
me a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> a -> [a] -> [a] -> [a]
doDiag [a]
as [a]
bs a
me ([a] -> [a]
forall a. [a] -> [a]
tail [a]
n) ([a] -> [a]
forall a. [a] -> [a]
tail [a]
w)

firstelt :: a
firstelt = a
1 a -> a -> a
forall a. Num a => a -> a -> a
+ [a] -> a
forall a. [a] -> a
diagBelow
thisdiag :: [a]
thisdiag =  a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> a -> [a] -> [a] -> [a]
forall a a.
(Num a, Ord a, Eq a) =>
[a] -> [a] -> a -> [a] -> [a] -> [a]
doDiag [a]
a' [a]
b'  [a]
diagAbove ([a] -> [a]
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 = [[a]] -> [a]
forall a. [a] -> a
forall a. [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 (t :: * -> *) a. Foldable t => t a -> Int
length [a]
a Int -> Int -> Int
forall a. Num a => a -> a -> 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. [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. [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. [a] -> Int -> a
!! (-Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lab)