1. Grzegorz Chrupała
  2. lingo

Commits

creswick  committed 7379506 Merge

Merged gchrupala/lingo into default

  • Participants
  • Parent commits 20a5370, 1c4d6e1
  • Branches default

Comments (0)

Files changed (3)

File aline/Align.hs

View file
          Op(..)
        , isEmpty
        , align
-       , shiftUp
+       , applyOps
+       , formatOp
+       , readOp
        )
 where       
 import LCS
 import qualified Data.Map  as Map
 import Data.Maybe
 
-data Op a = Op { inserts :: [a], deletes :: Maybe a } deriving (Show)
+data Op a = Op { deletes :: Maybe a, inserts :: [a] } deriving (Eq, Show)
+
+formatOp :: (Show a) => Op a -> String
+formatOp op = show $ (maybeToList . deletes $ op, inserts op)
+
+readOp :: (Read a) => String -> Op a
+readOp str = case reads str of
+  [((xs, ys), _)] -> Op { deletes = listToMaybe xs, inserts = ys }
+  other             -> error $ "readOp: no parse: " ++ str
+
 
 empty :: Op a
 empty = Op { inserts = [], deletes = Nothing }
 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] ]
+  in [ Map.findWithDefault empty i table | i <- [0 .. length src] ]
        
--- | 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 ]  
       ds = filter del es
   in Op { inserts = map char is, deletes = listToMaybe . map char $ ds }
 
+applyOps :: Eq a => [Op a] -> [a] -> [a]
+applyOps ops xs = 
+  catMaybes . concat $ [ applyOne x o | (x, o) <- zip (map Just xs ++ [Nothing]) ops ]
+  where applyOne x o = (map Just . inserts $ o) ++ [if isJust (deletes o) then Nothing else x]
+
 pos :: Edit a -> Int     
 pos (Ins _ i) = i
 pos (Del _ i) = i

File aline/aline.cabal

View file
 --  see http://haskell.org/cabal/users-guide/
 
 name:                aline
-version:             0.1.0.0
+version:             0.1.0.1
 synopsis:            Diff-like string alignment       
 -- description:         
 license:             BSD3
 executable aline
   main-is:             aline.hs
   build-depends:       base ==4.*, containers ==0.5.*, mtl ==2.1.*, binary ==0.7.*, 
-                       bytestring ==0.10.*, utf8-string ==0.3.*
+                       bytestring ==0.10.*, utf8-string ==0.3.*, split ==0.2.*

File aline/aline.hs

View file
 import Align
 import Codec.Binary.UTF8.String
 import Data.Word
-
+import Data.Maybe
+import qualified Data.List.Split as Split
+import Debug.Trace
 
 main :: IO ()
 main = do
-  [sf, tf] <- getArgs
+  command: args <- getArgs
+  case command of 
+    "align" -> doAlign args 
+    "apply" -> doApplyOps args
+
+doAlign :: [String] -> IO ()
+doAlign args = do
+  let [sf, tf] = args
   srcs <- lines <$> readFile sf 
   tgts <- lines <$> readFile tf 
   putStr . unlines . map format $ zipWith alignment srcs tgts
       
+doApplyOps :: [String] -> IO ()    
+doApplyOps args = do
+  let [bytef, opsf] = args
+  bytes <- map (map readByte)  . Split.splitWhen null . lines <$> readFile bytef
+  ops   <- map (map readOp)    . Split.splitWhen null . lines <$> readFile opsf
+  let strings = map (decode . dropLast) $ zipWith applyOps ops bytes
+  putStr . unlines $ strings
+    
+dropLast [] = []
+dropLast xs = init xs
+    
+readByte :: String -> Word8    
+readByte str = 
+  case reads str of
+    [(w,_)] -> w
+    other   -> error $ "readByte: invalid byte: " ++ show str
     
 alignment :: String -> String -> [(Word8, Op Word8)]    
-alignment src tgt = zip src' (shiftUp $ align src' tgt') 
+alignment src tgt = zip (src'++[0]) (align src' tgt') 
   where src' = encode src
         tgt' = encode tgt
         
 format :: [(Word8, Op Word8)] -> String
-format ops = unlines [ unwords [show c, formatOp op] | (c,op) <- ops ]
+format ops = unlines [ unwords [show c, formatOp (reduce op)] | (c,op) <- ops ]
 
-formatOp op | isEmpty op = "O"
-formatOp op = formatD (deletes op) ++ formatI (inserts op)
-
-formatI [] = ""
-formatI xs = "I"++show xs
-
-formatD Nothing = ""
-formatD (Just c) = "D;"
-
+reduce :: Op Word8 -> Op Word8
+reduce op = op { deletes = maybe Nothing (const (Just 0)) . deletes $ op }