Commits

Grzegorz Chrupała  committed 11951a6

Implemented alignment in Align

  • Participants
  • Parent commits caea2a5

Comments (0)

Files changed (4)

File aline/Align.hs

+module Align
+       (
+         Op(..)
+       , isEmpty
+       , align
+       , shiftUp
+       )
+where       
+import LCS
+import qualified Data.List as List
+import qualified Data.Map  as Map
+import Data.Maybe
+
+data Op a = Op { inserts :: [a], deletes :: Maybe a } deriving (Show)
+
+empty :: Op a
+empty = Op { inserts = [], deletes = Nothing }
+
+isEmpty :: Op a -> Bool
+isEmpty op = null (inserts op) && isNothing (deletes op)
+
+-- | 'align src tgt' for each position in src returns record of edit
+-- operations need to transform into tgt.
+align :: (Ord a) => [a] -> [a] -> [Op a]
+align src tgt = 
+  let table = compress $ ses src tgt 
+  in [ Map.findWithDefault empty i table | i <- [0 .. length src+1] ]
+       
+-- | shiftUp ops moves insert operations one position up.     
+shiftUp :: [Op a] -> [Op a]     
+shiftUp ops = zipWith shift ops (tail ops) 
+  where shift o1 o2 = o1 { inserts = inserts o2 }
+     
+compress :: [Edit a] -> Map.Map Int (Op a)
+compress es = Map.fromList [ (pos . head $ g, stringify g) 
+                           | g <- List.groupBy (\a b -> pos a == pos b) es ]  
+
+stringify :: [Edit a] -> Op a
+stringify es =
+  let is = filter ins es 
+      ds = filter del es
+  in Op { inserts = map char is, deletes = listToMaybe . map char $ ds }
+
+pos :: Edit a -> Int     
+pos (Ins _ i) = i
+pos (Del _ i) = i
+
+ins :: Edit a -> Bool
+ins (Ins _ _) = True
+ins _         = False
+
+del :: Edit a -> Bool
+del = not . ins
+   
+char :: Edit a -> a
+char (Ins a _) = a
+char (Del a _) = a
+   

File aline/EditTree.hs

 
 --import GramLab.Data.CommonSubstrings 
 import Data.List
-import qualified GramLab.Data.StringLike as S
+import qualified StringLike as S
 import Data.Maybe (fromMaybe)
 import Debug.Trace
 import Data.Binary

File aline/LCS.hs

 import qualified Data.Map as Map
 import Prelude hiding (lookup)
 import Data.Maybe (catMaybes)
-import Data.Binary hiding (put,get)
+import Data.Binary hiding (put, get)
 import qualified Data.Binary as B
 
 data Edit a       = Ins a Int
-                  | Del a Int deriving (Eq,Ord,Show,Read)
+                  | Del a Int deriving (Eq, Ord, Show, Read)
 type EditScript a = [Edit a]
 
 instance (Binary a) => Binary (Edit a) where

File aline/align.hs

+import Align
+import Data.Char
+
+main :: IO ()
+