From 0786dc6f42fdbf6a4039ffb47667c85d405af625 Mon Sep 17 00:00:00 2001 From: aarne Date: Wed, 4 Nov 2015 20:36:47 +0000 Subject: [PATCH] dependency labels in parse trees now with the -deps flag, -file=labels_file for configuration. With -nocat option this shows reasonable dep trees, more familiar looking than the vd command. With -showfun flag, the tree gives a rather complete picture of the analysis of the sentence. --- src/compiler/GF/Command/Commands.hs | 16 ++++++++--- src/runtime/haskell/PGF.hs | 1 + src/runtime/haskell/PGF/VisualizeTree.hs | 34 ++++++++++++++++++------ 3 files changed, 39 insertions(+), 12 deletions(-) diff --git a/src/compiler/GF/Command/Commands.hs b/src/compiler/GF/Command/Commands.hs index 32612df2c..015ba4931 100644 --- a/src/compiler/GF/Command/Commands.hs +++ b/src/compiler/GF/Command/Commands.hs @@ -572,7 +572,7 @@ pgfCommands = Map.fromList [ ("v","show extra information") ], flags = [ - ("file","configuration file for labels per fun, format 'fun l1 ... label ... l2'"), + ("file","configuration file for labels, format per line 'fun label*'"), ("format","format of the visualization file (default \"png\")"), ("output","output format of graph source (default \"dot\")"), ("view","program to open the resulting file (default \"open\")"), @@ -597,7 +597,7 @@ pgfCommands = Map.fromList [ let gvOptions = GraphvizOptions {noLeaves = isOpt "noleaves" opts && not (isOpt "showleaves" opts), noFun = isOpt "nofun" opts || not (isOpt "showfun" opts), noCat = isOpt "nocat" opts && not (isOpt "showcat" opts), - noDep = True, ---- TODO + noDep = not (isOpt "deps" opts), nodeFont = valStrOpts "nodefont" "" opts, leafFont = valStrOpts "leaffont" "" opts, nodeColor = valStrOpts "nodecolor" "" opts, @@ -605,9 +605,14 @@ pgfCommands = Map.fromList [ nodeEdgeStyle = valStrOpts "nodeedgestyle" "solid" opts, leafEdgeStyle = valStrOpts "leafedgestyle" "dashed" opts } + let depfile = valStrOpts "file" "" opts + mlab <- case depfile of + "" -> return Nothing + _ -> (Just . getDepLabels . lines) `fmap` restricted (readFile depfile) + let grph = if null es then [] - else graphvizParseTree pgf lang gvOptions (head es) + else graphvizParseTreeDep mlab pgf lang gvOptions (head es) if isFlag "view" opts || isFlag "format" opts then do let file s = "_grph." ++ s let view = optViewGraph opts @@ -619,11 +624,13 @@ pgfCommands = Map.fromList [ else return $ fromString grph, examples = [ mkEx "p \"John walks\" | vp -- generate a tree and show parse tree as .dot script", - mkEx "gr | vp -view=\"open\" -- generate a tree and display parse tree on a Mac" + mkEx "gr | vp -view=open -- generate a tree and display parse tree on a Mac", + mkEx "p \"she loves us\" | vp -view=open -deps -file=uddeps.labels -nocat" -- show a visual variant of a dependency tree" ], options = [ ("showcat","show categories in the tree nodes (default)"), ("nocat","don't show categories"), + ("deps","show dependency labels"), ("showfun","show function names in the tree nodes"), ("nofun","don't show function names (default)"), ("showleaves","show the leaves of the tree (default)"), @@ -631,6 +638,7 @@ pgfCommands = Map.fromList [ ], flags = [ ("lang","the language to visualize"), + ("file","configuration file for dependency labels with -deps, format per line 'fun label*'"), ("format","format of the visualization file (default \"png\")"), ("view","program to open the resulting file (default \"open\")"), ("nodefont","font for tree nodes (default: Times -- graphviz standard font)"), diff --git a/src/runtime/haskell/PGF.hs b/src/runtime/haskell/PGF.hs index 07c14324f..9259bacb4 100644 --- a/src/runtime/haskell/PGF.hs +++ b/src/runtime/haskell/PGF.hs @@ -122,6 +122,7 @@ module PGF( -- ** Visualizations graphvizAbstractTree, graphvizParseTree, + graphvizParseTreeDep, graphvizDependencyTree, graphvizBracketedString, graphvizAlignment, diff --git a/src/runtime/haskell/PGF/VisualizeTree.hs b/src/runtime/haskell/PGF/VisualizeTree.hs index ad043a505..f0b4de1ac 100644 --- a/src/runtime/haskell/PGF/VisualizeTree.hs +++ b/src/runtime/haskell/PGF/VisualizeTree.hs @@ -14,6 +14,7 @@ module PGF.VisualizeTree , graphvizDefaults , graphvizAbstractTree , graphvizParseTree + , graphvizParseTreeDep , graphvizDependencyTree , graphvizBracketedString , graphvizAlignment @@ -255,20 +256,20 @@ graphvizBracketedString opts mbl tree bss = render graphviz_code internal_nodes = [mkLevel internals | internals <- getInternals (map ((,) nil) bss), not (null internals)] - leaf_nodes = mkLevel [(parent, id, word) | - (id, (parent, word)) <- zip [100000..] (concatMap (getLeaves nil) bss)] + leaf_nodes = mkLevel [(parent, id, mkLeafNode cat word) | + (id, (parent, (cat,word))) <- zip [100000..] (concatMap (getLeaves (mkCId "?") nil) bss)] getInternals [] = [] getInternals nodes = nub [(parent, fid, mkNode fun cat) | - (parent, Bracket cat fid lind fun _ _) <- nodes] + (parent, Bracket cat fid _ fun _ _) <- nodes] : getInternals [(fid, child) | (_, Bracket _ fid _ _ _ children) <- nodes, child <- children] - getLeaves parent (Leaf word) = [(parent, word)] - getLeaves parent (Bracket _ fid i _ _ children) - = concatMap (getLeaves fid) children + getLeaves cat parent (Leaf word) = [(parent, (cat, word))] -- the lowest cat before the word + getLeaves _ parent (Bracket cat fid i _ _ children) + = concatMap (getLeaves cat fid) children mkLevel nodes = text "subgraph {rank=same;" $$ @@ -288,10 +289,27 @@ graphvizBracketedString opts mbl tree bss = render graphviz_code depLabel node@(parent,id,lbl) | noDep opts = ";" | otherwise = case getArg id of - Just (fun,arg) -> (mkOption "" "label" (showCId fun ++ "#" ++ show arg)) + Just (fun,arg) -> mkOption "" "label" (lookLabel fun arg) _ -> ";" getArg i = getArgumentPlace i (expr2numtree tree) Nothing + labels = maybe Map.empty id mbl + + lookLabel fun arg = case Map.lookup fun labels of + Just xx | length xx > arg -> case xx !! arg of + "head" -> "" + l -> l + _ -> argLabel fun arg + argLabel fun arg = showCId fun ++ "#" ++ show arg + + mkLeafNode cat word + | noDep opts = word --- || not (noCat opts) -- show POS only if intermediate nodes hidden + | otherwise = posCat cat ++ "\n" ++ word -- show POS in dependency tree + + posCat cat = case Map.lookup cat labels of + Just [p] -> p + _ -> showCId cat + ---- to restore the argument place from bracketed linearization data NumTree = NumTree Int CId [NumTree] @@ -314,7 +332,7 @@ expr2numtree = fst . renumber 0 . flatten where t:tt -> case renumber i t of (t',j) -> case renumbers j tt of (tt',k) -> (t':tt',k) _ -> ([],i) ------ end this terrible stuff +----- end this terrible stuff AR 4/11/2015