msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

giza alignment in the C shell

Browse Source
This commit is contained in:
Krasimir Angelov
2017-09-01 08:23:12 +02:00
parent 983e804223
commit 1182a9b63d
1 changed files with 31 additions and 26 deletions
Download Patch File Download Diff File Expand all files Collapse all files

57
src/compiler/GF/Command/Commands2.hs
View File

@@ -35,7 +35,7 @@ import GF.Command.CommandInfo
import GF.Data.Operations import GF.Data.Operations
--import PGF.Internal (encodeFile) --import PGF.Internal (encodeFile)
import Data.List(intersperse,nub) import Data.List(intersperse,intersect,nub)
import Data.Maybe import Data.Maybe
import qualified Data.Map as Map import qualified Data.Map as Map
--import System.Cmd(system) -- use GF.Infra.UseIO.restricedSystem instead! --import System.Cmd(system) -- use GF.Infra.UseIO.restricedSystem instead!
@@ -72,30 +72,29 @@ pgfCommands = Map.fromList [
], ],
exec = needPGF $ \opts es env -> do exec = needPGF $ \opts es env -> do
let cncs = optConcs env opts let cncs = optConcs env opts
{-if isOpt "giza" opts if isOpt "giza" opts
then do then if length cncs == 2
let giz = map (H.gizaAlignment pgf (head $ langs, head $ tail $ langs)) es then let giz = map (gizaAlignment pgf (snd (cncs !! 0)) (snd (cncs !! 1)) . cExpr) (toExprs es)
let lsrc = unlines $ map (\(x,_,_) -> x) giz lsrc = unlines $ map (\(x,_,_) -> x) giz
let ltrg = unlines $ map (\(_,x,_) -> x) giz ltrg = unlines $ map (\(_,x,_) -> x) giz
let align = unlines $ map (\(_,_,x) -> x) giz align = unlines $ map (\(_,_,x) -> x) giz
let grph = if null es then [] else lsrc ++ "\n--end_source--\n\n"++ltrg++"\n-end_target--\n\n"++align grph = if null (toExprs es) then [] else lsrc ++ "\n--end_source--\n\n"++ltrg++"\n-end_target--\n\n"++align
return $ fromString grph in return (fromString grph)
else do-} else error "For giza alignment you need exactly two languages"
do let gvOptions=graphvizDefaults{leafFont = valStrOpts "font" "" opts, else let gvOptions=graphvizDefaults{leafFont = valStrOpts "font" "" opts,
leafColor = valStrOpts "color" "" opts, leafColor = valStrOpts "color" "" opts,
leafEdgeStyle = valStrOpts "edgestyle" "" opts leafEdgeStyle = valStrOpts "edgestyle" "" opts
} }
grph = if null (toExprs es) then [] else graphvizWordAlignment (map snd cncs) gvOptions (cExpr (head (toExprs es))) grph = if null (toExprs es) then [] else graphvizWordAlignment (map snd cncs) gvOptions (cExpr (head (toExprs es)))
if isFlag "view" opts || isFlag "format" opts in if isFlag "view" opts || isFlag "format" opts
then do then do let file s = "_grph." ++ s
let file s = "_grph." ++ s let view = optViewGraph opts
let view = optViewGraph opts let format = optViewFormat opts
let format = optViewFormat opts restricted $ writeUTF8File (file "dot") grph
restricted $ writeUTF8File (file "dot") grph restrictedSystem $ "dot -T" ++ format ++ " " ++ file "dot" ++ " > " ++ file format
restrictedSystem $ "dot -T" ++ format ++ " " ++ file "dot" ++ " > " ++ file format restrictedSystem $ view ++ " " ++ file format
restrictedSystem $ view ++ " " ++ file format return void
return void else return (fromString grph),
else return $ fromString grph,
examples = [ examples = [
("gr | aw" , "generate a tree and show word alignment as graph script"), ("gr | aw" , "generate a tree and show word alignment as graph script"),
("gr | aw -view=\"open\"" , "generate a tree and display alignment on Mac"), ("gr | aw -view=\"open\"" , "generate a tree and display alignment on Mac"),
@@ -771,8 +770,14 @@ pgfCommands = Map.fromList [
showFun pgf f = showFun' f (functionType pgf f) showFun pgf f = showFun' f (functionType pgf f)
showFun' f ty = "fun "++f++" : "++showType [] ty showFun' f ty = "fun "++f++" : "++showType [] ty
gizaAlignment pgf src_cnc tgt_cnc e =
let src_res = alignWords src_cnc e
tgt_res = alignWords tgt_cnc e
alignment = [show i++"-"++show j | (i,(_,src_fids)) <- zip [0..] src_res, (j,(_,tgt_fids)) <- zip [0..] tgt_res, not (null (intersect src_fids tgt_fids))]
in (unwords (map fst src_res), unwords (map fst tgt_res), unwords alignment)
morphos env opts s = morphos env opts s =
[(s,lookupMorpho concr s) | (lang,concr) <- optConcs env opts] [(s,res) | (lang,concr) <- optConcs env opts, let res = lookupMorpho concr s, not (null res)]
{- {-
mexp xs = case xs of mexp xs = case xs of
t:_ -> Just t t:_ -> Just t