module Options.Applicative.Help.Levenshtein (
editDistance
) where
editDistance :: Eq a => [a] -> [a] -> Int
editDistance a b = last $
case () of
_ | lab == 0
-> mainDiag
| lab > 0
-> lowers !! (lab - 1)
| otherwise
-> uppers !! (-1 - lab)
where
mainDiag = oneDiag a b (head uppers) (-1 : head lowers)
uppers = eachDiag a b (mainDiag : uppers)
lowers = eachDiag b a (mainDiag : lowers)
eachDiag _ [] _ = []
eachDiag _ _ [] = []
eachDiag a' (_:bs) (lastDiag:diags) =
oneDiag a' bs nextDiag lastDiag : eachDiag a' bs diags
where
nextDiag = head (tail diags)
oneDiag a' b' diagAbove diagBelow = thisdiag
where
doDiag [] _ _ _ _ = []
doDiag _ [] _ _ _ = []
doDiag (ach:ach':as) (bch:bch':bs) nw n w
| ach' == bch && ach == bch'
= nw : doDiag (ach' : as) (bch' : bs) nw (tail n) (tail w)
doDiag (ach:as) (bch:bs) nw n w =
me : doDiag as bs me (tail n) (tail w)
where
me =
if ach == bch
then nw
else 1 + min3 (head w) nw (head n)
firstelt = 1 + head diagBelow
thisdiag = firstelt : doDiag a' b' firstelt diagAbove (tail diagBelow)
lab = length a - length b
min3 x y z =
if x < y
then x
else min y z