mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-17 16:59:34 -06:00
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.
This commit is contained in:
@@ -122,6 +122,7 @@ module PGF(
|
||||
-- ** Visualizations
|
||||
graphvizAbstractTree,
|
||||
graphvizParseTree,
|
||||
graphvizParseTreeDep,
|
||||
graphvizDependencyTree,
|
||||
graphvizBracketedString,
|
||||
graphvizAlignment,
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
|
||||
|
||||
Reference in New Issue
Block a user