diff --git a/lib/src/Makefile b/lib/src/Makefile index 998b11329..df2cce3ab 100644 --- a/lib/src/Makefile +++ b/lib/src/Makefile @@ -25,7 +25,7 @@ compat: $(RUNMAKE) present compat prelude: - gf -batch prelude/*.gf + gf -batch -path=prelude prelude/*.gf cp -p prelude/*.gfo ../prelude constructX: diff --git a/lib/src/norwegian/LexiconNor.gf b/lib/src/norwegian/LexiconNor.gf index ed74cd1ba..cdc17ec3c 100644 --- a/lib/src/norwegian/LexiconNor.gf +++ b/lib/src/norwegian/LexiconNor.gf @@ -120,7 +120,7 @@ lin milk_N = regGenN "melk" masculine ; moon_N = regGenN "måne" masculine ; mother_N2 = mkN2 (mkN "mor" "moren" "mødre" "mødrene") (mkPrep "til") ; ---- fem - mountain_N = regGenN "berg" neutrum ; + mountain_N = regGenN "fjell" neutrum ; music_N = mk2N "musikk" "musikken" ; narrow_A = regADeg "smal" ; new_A = mkADeg "ny" "nytt" "nye" "nyere" "nyest" ; diff --git a/lib/src/norwegian/ParadigmsNor.gf b/lib/src/norwegian/ParadigmsNor.gf index cdb71a1e6..67ad4d8d2 100644 --- a/lib/src/norwegian/ParadigmsNor.gf +++ b/lib/src/norwegian/ParadigmsNor.gf @@ -328,7 +328,7 @@ oper {s = table {NPPoss _ => x ; _ => y} ; a = agrP3 g n ; lock_NP = <>} ; - mk3A a b c = (mkAdject a b c [] []) ** {isComp = False ; lock_A = <>} ; + mk3A = mk3ADeg ; ---- (mkAdject a b c [] []) ** {isComp = False ; lock_A = <>} ; mk2A a b = mk3A a b (a + "e") ; regA a = (regADeg a) ** {isComp = False ; lock_A = <>} ; diff --git a/src/GF/Command/Commands.hs b/src/GF/Command/Commands.hs index 5fdceee58..8284c5e2c 100644 --- a/src/GF/Command/Commands.hs +++ b/src/GF/Command/Commands.hs @@ -565,6 +565,44 @@ allCommands cod env@(pgf, mos) = Map.fromList [ options = transliterationPrintNames }), + ("vd", emptyCommandInfo { + longname = "visualize_dependency", + synopsis = "show word dependency tree graphically", + explanation = unlines [ + "Prints a dependency tree the .dot format (the graphviz format).", + "By default, the last argument is the head of every abstract syntax", + "function; moreover, the head depends on the head of the function above.", + "The graph can be saved in a file by the wf command as usual.", + "If the -view flag is defined, the graph is saved in a temporary file", + "which is processed by graphviz and displayed by the program indicated", + "by the flag. The target format is png, unless overridden by the", + "flag -format." + ], + exec = \opts es -> do + let lang = optLang opts + let grph = if null es then [] else dependencyTree Nothing pgf lang (head es) + if isFlag "view" opts || isFlag "format" opts then do + let file s = "_grph." ++ s + let view = optViewGraph opts ++ " " + let format = optViewFormat opts + writeFile (file "dot") (enc grph) + system $ "dot -T" ++ format ++ " " ++ file "dot" ++ " > " ++ file format ++ + " ; " ++ view ++ file format + return void + else return $ fromString grph, + examples = [ + "gr | aw -- generate a tree and show word alignment as graph script", + "gr | vt -view=\"open\" -- generate a tree and display alignment on a Mac" + ], + options = [ + ], + flags = [ + ("format","format of the visualization file (default \"png\")"), + ("view","program to open the resulting file (default \"open\")") + ] + }), + + ("vp", emptyCommandInfo { longname = "visualize_parse", synopsis = "show parse tree graphically", diff --git a/src/PGF/VisualizeTree.hs b/src/PGF/VisualizeTree.hs index 3599afe4d..f363e12ec 100644 --- a/src/PGF/VisualizeTree.hs +++ b/src/PGF/VisualizeTree.hs @@ -15,7 +15,7 @@ -- instead of rolling its own. ----------------------------------------------------------------------------- -module PGF.VisualizeTree ( visualizeTrees, parseTree, alignLinearize +module PGF.VisualizeTree ( visualizeTrees, parseTree, dependencyTree, alignLinearize ,PosText(..),readPosText ) where @@ -25,7 +25,7 @@ import PGF.Tree import PGF.Linearize import PGF.Macros (lookValCat) -import Data.List (intersperse,nub) +import Data.List (intersperse,nub,isPrefixOf,sort,sortBy) import Data.Char (isDigit) import qualified Text.ParserCombinators.ReadP as RP @@ -57,6 +57,37 @@ prGraph digr ns = concat $ map (++"\n") $ [graph ++ "{\n"] ++ ns ++ ["}"] where graph = if digr then "digraph" else "graph" +-- dependency trees from Linearize.linearizeMark + +dependencyTree :: Maybe String -> PGF -> CId -> Expr -> String +dependencyTree ms pgf lang = prGraph True . lin2dep pgf . linMark where + linMark = head . linearizesMark pgf lang + ---- use Just str if you have str to match against + +lin2dep pgf s = trace s $ trace (show sortedNodeWords) $ prelude ++ nodes ++ links where + + prelude = ["rankdir=LR ;", "node [shape = plaintext] ;"] + + nodes = map mkNode nodeWords + mkNode (i,(p,ss)) = + show (show i) ++ " [label = \"" ++ show i ++ ". " ++ show p ++ unwords ss ++ "\"] ;" + + links = map mkLink [(x,dominant x) | x <- init sortedNodeWords] + dominant x = head [y | y <- sortedNodeWords, y /=x, dominates (pos y) (pos x)] + dominates y x = y /= x && isPrefixOf y x + sortedNodeWords = reverse $ sortBy (\x y -> compare (length (pos x)) (length (pos y))) $ + sortBy (\x y -> compare (pos x) (pos y)) nodeWords + pos = fst . snd + + linkss = map mkLink [(x,y) | x <- nodeWords, y <- nodeWords, x /= y, depends x y] + mkLink (x,y) = show (fst x) ++ " -> " ++ show (fst y) ; + depends (_,(p,_)) (_,(q,_)) = sister p q || daughter p q + daughter p q = not (null p) && init p == q && (null q || last q == 0) + sister p q = False -- not (null p) && not (null q) && init p == init q && last q == 0 + + nodeWords = (0,([],["ROOT"])) : zip [1..] [(p++[0],f)| (p,f) <- wlins (readPosText s)] + + -- parse trees from Linearize.linearizeMark ---- nubrec and domins are quadratic, but could be (n log n)