Skip to content

Instantly share code, notes, and snippets.

@KWMalik
Forked from supki/algorithms.hs
Created July 30, 2012 20:08
Show Gist options
  • Save KWMalik/3209750 to your computer and use it in GitHub Desktop.
Save KWMalik/3209750 to your computer and use it in GitHub Desktop.
Strings distance count algorithms from Stanford NLP course.
import Control.Arrow ((***), second)
import Data.Array
import Data.Function (on)
import Data.List (minimumBy)
data Action = Ins
| Del
| Sub
| Id
deriving Show
levenstein :: String -> String -> (Int, [Action])
levenstein x y = second reverse $ ds ! (length x, length y)
where ds :: Array (Int, Int) (Int, [Action])
ds = array ((0, 0), (length x, length y)) [((i, j), d i j) | i <- [0..length x], j <- [0..length y]]
d :: Int -> Int -> (Int, [Action])
d i 0 = (i, replicate i Ins)
d 0 j = (j, replicate j Del)
d i j = minimumBy (compare `on` fst)
[ ins (ds ! (i-1, j))
, del (ds ! (i, j-1))
, sub (ds ! (i-1, j-1))
]
where ins, del, sub :: (Int, [Action]) -> (Int, [Action])
ins = let weight = 1
in (+ weight) *** (Ins:)
del = let weight = 1
in (+ weight) *** (Del:)
sub = let weight = 2
in case x !! (i-1) == y !! (j - 1) of
True -> second (Id:)
False -> (+ weight) *** (Sub:)
needleman_wunsch :: String -> String -> Int
needleman_wunsch x y = max (maximum [d (length x) j | j <- [1..length y]]) (maximum [d i (length y) | i <- [1..length x]])
where d :: Int -> Int -> Int
d _ 0 = 0
d 0 _ = 0
d i j = maximum
[ d (i-1) j - w
, d i (j-1) - w
, d (i-1) (j-1) + s (x !! (i-1)) (y !! (j-1))
]
s :: Char -> Char -> Int
s a b | a == b = 1
| otherwise = (-2) * w
w :: Int
w = 1
smith_waterman :: String -> String -> Int
smith_waterman x y = max (maximum [d (length x) j | j <- [1..length y]]) (maximum [d i (length y) | i <- [1..length x]])
where d :: Int -> Int -> Int
d _ 0 = 0
d 0 _ = 0
d i j = maximum
[ 0
, d (i-1) j - w
, d i (j-1) - w
, d (i-1) (j-1) + s (x !! (i-1)) (y !! (j-1))
]
s :: Char -> Char -> Int
s a b | a == b = 1
| otherwise = (-2) * w
w :: Int
w = 1
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment