github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-25 16:02:43 +03:00
Code Issues Projects Releases Wiki Activity

Rename EditDistance to Distance.

Browse Source
This commit is contained in:
Rob Rix 2017-03-13 18:21:05 -04:00
parent 06cea9d528
commit 381e271924
1 changed files with 20 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
src/SES/Myers.hs
View File

@ -13,10 +13,10 @@ import Prologue hiding (for, State)
data MyersF element result where data MyersF element result where
SES :: EditGraph a -> MyersF a [These a a] SES :: EditGraph a -> MyersF a [These a a]
LCS :: EditGraph a -> MyersF a [a] LCS :: EditGraph a -> MyersF a [a]
MiddleSnake :: EditGraph a -> MyersF a (Snake, EditDistance) MiddleSnake :: EditGraph a -> MyersF a (Snake, Distance)
SearchUpToD :: EditGraph a -> EditDistance -> MyersF a (Maybe (Snake, EditDistance)) SearchUpToD :: EditGraph a -> Distance -> MyersF a (Maybe (Snake, Distance))
SearchAlongK :: EditGraph a -> EditDistance -> Direction -> Diagonal -> MyersF a (Maybe (Snake, EditDistance)) SearchAlongK :: EditGraph a -> Distance -> Direction -> Diagonal -> MyersF a (Maybe (Snake, Distance))
FindDPath :: EditGraph a -> EditDistance -> Direction -> Diagonal -> MyersF a Endpoint FindDPath :: EditGraph a -> Distance -> Direction -> Diagonal -> MyersF a Endpoint
data State s a where data State s a where
Get :: State s s Get :: State s s
@ -35,7 +35,7 @@ data EditGraph a = EditGraph { as :: !(Vector.Vector a), bs :: !(Vector.Vector a
data Snake = Snake { xy :: Endpoint, uv :: Endpoint } data Snake = Snake { xy :: Endpoint, uv :: Endpoint }
deriving (Eq, Show) deriving (Eq, Show)
newtype EditDistance = EditDistance { unEditDistance :: Int } newtype Distance = Distance { unDistance :: Int }
deriving (Eq, Show) deriving (Eq, Show)
newtype Diagonal = Diagonal { unDiagonal :: Int } newtype Diagonal = Diagonal { unDiagonal :: Int }
@ -79,7 +79,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
LCS graph LCS graph
| null as || null bs -> return [] | null as || null bs -> return []
| otherwise -> do | otherwise -> do
(Snake xy uv, EditDistance d) <- middleSnake graph (Snake xy uv, Distance d) <- middleSnake graph
if d > 1 then do if d > 1 then do
let (before, _) = divideGraph graph xy let (before, _) = divideGraph graph xy
let (start, after) = divideGraph graph uv let (start, after) = divideGraph graph uv
@ -96,7 +96,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
| null bs -> return (This <$> toList as) | null bs -> return (This <$> toList as)
| null as -> return (That <$> toList bs) | null as -> return (That <$> toList bs)
| otherwise -> do | otherwise -> do
(Snake xy uv, EditDistance d) <- middleSnake graph (Snake xy uv, Distance d) <- middleSnake graph
if d > 1 then do if d > 1 then do
let (before, _) = divideGraph graph xy let (before, _) = divideGraph graph xy
let (start, after) = divideGraph graph uv let (start, after) = divideGraph graph uv
@ -108,14 +108,14 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
return (zipWith These (toList as) (toList bs)) return (zipWith These (toList as) (toList bs))
MiddleSnake graph -> do MiddleSnake graph -> do
result <- for [0..maxD] (searchUpToD graph . EditDistance) result <- for [0..maxD] (searchUpToD graph . Distance)
case result of case result of
Just result -> return result Just result -> return result
Nothing -> error "MiddleSnake must always find a value." Nothing -> error "MiddleSnake must always find a value."
SearchUpToD graph (EditDistance d) -> SearchUpToD graph (Distance d) ->
(<|>) <$> for [negate d, negate d + 2 .. d] (searchAlongK graph (EditDistance d) Forward . Diagonal) (<|>) <$> for [negate d, negate d + 2 .. d] (searchAlongK graph (Distance d) Forward . Diagonal)
<*> for [negate d, negate d + 2 .. d] (searchAlongK graph (EditDistance d) Reverse . Diagonal) <*> for [negate d, negate d + 2 .. d] (searchAlongK graph (Distance d) Reverse . Diagonal)
SearchAlongK graph d direction (Diagonal k) -> do SearchAlongK graph d direction (Diagonal k) -> do
(forwardEndpoint, reverseEndpoint) <- endpointsFor graph d direction k (forwardEndpoint, reverseEndpoint) <- endpointsFor graph d direction k
@ -124,7 +124,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
else else
continue continue
FindDPath _ (EditDistance d) direction (Diagonal k) -> do FindDPath _ (Distance d) direction (Diagonal k) -> do
v <- gets (stateFor direction) v <- gets (stateFor direction)
eq <- getEq eq <- getEq
let prev = v ! offsetFor direction + pred k let prev = v ! offsetFor direction + pred k
@ -145,8 +145,8 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
inInterval (Diagonal k) (lower, upper) = k >= lower && k <= upper inInterval (Diagonal k) (lower, upper) = k >= lower && k <= upper
diagonalInterval Forward (EditDistance d) = (delta - pred d, delta + pred d) diagonalInterval Forward (Distance d) = (delta - pred d, delta + pred d)
diagonalInterval Reverse (EditDistance d) = (negate d, d) diagonalInterval Reverse (Distance d) = (negate d, d)
diagonalFor Forward k = Diagonal k diagonalFor Forward k = Diagonal k
diagonalFor Reverse k = Diagonal (k + delta) diagonalFor Reverse k = Diagonal (k + delta)
@ -175,8 +175,8 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
let x = v ! offsetFor direction + unDiagonal (diagonalFor direction k) in return $ Endpoint x (x - k) let x = v ! offsetFor direction + unDiagonal (diagonalFor direction k) in return $ Endpoint x (x - k)
done (Endpoint x y) uv d = Just (Snake (Endpoint (n - x) (m - y)) uv, d) done (Endpoint x y) uv d = Just (Snake (Endpoint (n - x) (m - y)) uv, d)
editDistance Forward (EditDistance d) = EditDistance (2 * d - 1) editDistance Forward (Distance d) = Distance (2 * d - 1)
editDistance Reverse (EditDistance d) = EditDistance (2 * d) editDistance Reverse (Distance d) = Distance (2 * d)
slide dir eq (Endpoint x y) slide dir eq (Endpoint x y)
| x >= 0, x < length as | x >= 0, x < length as
@ -196,16 +196,16 @@ ses graph = M (SES graph) `Then` return
lcs :: HasCallStack => EditGraph a -> Myers a [a] lcs :: HasCallStack => EditGraph a -> Myers a [a]
lcs graph = M (LCS graph) `Then` return lcs graph = M (LCS graph) `Then` return
middleSnake :: HasCallStack => EditGraph a -> Myers a (Snake, EditDistance) middleSnake :: HasCallStack => EditGraph a -> Myers a (Snake, Distance)
middleSnake graph = M (MiddleSnake graph) `Then` return middleSnake graph = M (MiddleSnake graph) `Then` return
searchUpToD :: HasCallStack => EditGraph a -> EditDistance -> Myers a (Maybe (Snake, EditDistance)) searchUpToD :: HasCallStack => EditGraph a -> Distance -> Myers a (Maybe (Snake, Distance))
searchUpToD graph distance = M (SearchUpToD graph distance) `Then` return searchUpToD graph distance = M (SearchUpToD graph distance) `Then` return
searchAlongK :: HasCallStack => EditGraph a -> EditDistance -> Direction -> Diagonal -> Myers a (Maybe (Snake, EditDistance)) searchAlongK :: HasCallStack => EditGraph a -> Distance -> Direction -> Diagonal -> Myers a (Maybe (Snake, Distance))
searchAlongK graph d direction k = M (SearchAlongK graph d direction k) `Then` return searchAlongK graph d direction k = M (SearchAlongK graph d direction k) `Then` return
findDPath :: HasCallStack => EditGraph a -> EditDistance -> Direction -> Diagonal -> Myers a Endpoint findDPath :: HasCallStack => EditGraph a -> Distance -> Direction -> Diagonal -> Myers a Endpoint
findDPath graph d direction k = M (FindDPath graph d direction k) `Then` return findDPath graph d direction k = M (FindDPath graph d direction k) `Then` return
getEq :: HasCallStack => Myers a (a -> a -> Bool) getEq :: HasCallStack => Myers a (a -> a -> Bool)