GenI 0.20 → 0.20.1
raw patch · 9 files changed
+439/−420 lines, 9 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- GenI.cabal +2/−2
- NEWS +1/−1
- src/NLP/GenI/GeniParsers.lhs +13/−3
- src/NLP/GenI/GeniShow.hs +171/−0
- src/NLP/GenI/GeniShow.lhs +0/−185
- src/NLP/GenI/Graphviz.hs +4/−2
- src/NLP/GenI/GraphvizShow.hs +199/−0
- src/NLP/GenI/GraphvizShow.lhs +0/−222
- src/NLP/GenI/Gui.lhs +49/−5
GenI.cabal view
@@ -1,5 +1,5 @@ Name: GenI-Version: 0.20+Version: 0.20.1 License: GPL License-file: LICENSE Author: Carlos Areces and Eric Kow@@ -53,7 +53,7 @@ src/NLP/GenI/Test.hs src/NLP/GenI/Simple/SimpleGui.lhs, src/NLP/GenI/Gui.lhs- src/NLP/GenI/GraphvizShow.lhs,+ src/NLP/GenI/GraphvizShow.hs, src/NLP/GenI/GuiHelper.hs src/NLP/GenI/Console.hs, src/NLP/GenI/Graphviz.hs
NEWS view
@@ -6,7 +6,6 @@ * Input files now *assumed* to be UTF-8 encoded (output still ISO8859-1; hopefully locale-based in GHC 6.12) * Interface between GenI and morphological realiser now uses a JSON format.- * --macros renamed to --schemata (still -m) * Rootfeat optimisation now mandatory (flag no longer recognised) - NEW FUNCTIONALITY@@ -19,6 +18,7 @@ * --batchdir now works with instructions files * --metrics always expands 'default' to the default metrics (in addition to any other statistics you request)+ * new optimisation: early null-adjunction detection - QUALITY ASSURANCE
src/NLP/GenI/GeniParsers.lhs view
@@ -190,8 +190,9 @@ formally, \begin{SaveVerbatim}{KoweyTmp}-<feature-structure> ::= "[" <atttribute-value-pair>* "]"-<attribute-value-pair> ::= <identifier> ":" <value>+<feature-structure> ::= "[" <atttribute-value-pair>* "]"+<attribute-value-pair> ::= <identifier-or-reserved> ":" <value>+<identifier-or-reserved> ::= <identifier> | <reserved> \end{SaveVerbatim} \begin{center} \fbox{\BUseVerbatim{KoweyTmp}}@@ -203,7 +204,7 @@ geniAttVal :: Parser AvPair geniAttVal = do- att <- identifier <?> "an attribute"; colon+ att <- identifierR <?> "an attribute"; colon val <- geniValue <?> "a GenI value" return $ AvPair att val \end{code}@@ -892,6 +893,15 @@ -- ---------------------------------------------------------------------- -- parsec helpers -- ----------------------------------------------------------------------++-- | identifier, permitting reserved words too+identifierR :: CharParser () String+identifierR+ = do { c <- P.identStart geniLanguageDef+ ; cs <- many (P.identLetter geniLanguageDef)+ ; return (c:cs)+ }+ <?> "identifier or reserved word" tillEof :: Parser a -> Parser a tillEof p =
+ src/NLP/GenI/GeniShow.hs view
@@ -0,0 +1,171 @@+-- GenI surface realiser+-- Copyright (C) 2005 Carlos Areces and Eric Kow+--+-- This program is free software; you can redistribute it and/or+-- modify it under the terms of the GNU General Public License+-- as published by the Free Software Foundation; either version 2+-- of the License, or (at your option) any later version.+--+-- This program is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+-- GNU General Public License for more details.+--+-- You should have received a copy of the GNU General Public License+-- along with this program; if not, write to the Free Software+-- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.++{-+We need to be able to dump some of GenI's data structures into a simple+text format we call GeniHand.++There are at least two uses for this, one is that it allows us to+interrupt the debugging process, dump everything to file, muck around+with the trees and then pick up where we left off.++The other use is to make large grammars faster to load. We don't actually do+this anymore, mind you, but it's nice to have the option. The idea is to take+a massive XML grammar, parse it to a set of TagElems and then write these back+in the lighter syntax. It's not that XML is inherently less efficient to parse+than the handwritten syntax, just that writing an efficient parser for XML+based format is more annoying, so I stuck with HaXml to make my life easy.+Unfortunately, HaXml seems to have some kind of space leak.+-}++-- This module provides specialised functions for visualising tree data.+module NLP.GenI.GeniShow+where++import Data.Tree+import Data.List(intersperse, isPrefixOf)+import qualified Data.Map as Map++import NLP.GenI.Tags+ ( TagElem, idname,+ tsemantics, ttree, tinterface, ttype, ttreename,+ )+import NLP.GenI.Btypes (GeniVal(GConst), AvPair(..), Ptype(..),+ Ttree(params, pidname, pfamily, pinterface, ptype, tree, psemantics, ptrace),+ GNode(..), GType(..),+ SemInput, Pred,+ TestCase(..),+ )++class GeniShow a where+ geniShow :: a -> String++instance GeniShow Ptype where+ geniShow Initial = "initial"+ geniShow Auxiliar = "auxiliary"+ geniShow _ = ""++instance GeniShow AvPair where+ geniShow (AvPair a v) = a ++ ":" ++ geniShow v++instance GeniShow GeniVal where+ geniShow (GConst xs) = concat $ intersperse "|" xs+ geniShow x = show x++instance GeniShow Pred where+ geniShow (h, p, l) =+ showh ++ geniShow p ++ "(" ++ unwords (map geniShow l) ++ ")"+ where+ hideh (GConst [x]) = "genihandle" `isPrefixOf` x+ hideh _ = False+ showh = if hideh h then "" else geniShow h ++ ":"++instance GeniShow GNode where+ geniShow x =+ let gaconstrstr = case (gaconstr x, gtype x) of+ (True, Other) -> "aconstr:noadj"+ _ -> ""+ gtypestr n = case (gtype n) of+ Subs -> "type:subst"+ Foot -> "type:foot"+ Lex -> if ganchor n && (null.glexeme) n+ then "type:anchor" else "type:lex"+ _ -> ""+ glexstr n =+ if null ls then ""+ else concat $ intersperse "|" $ map quote ls+ where quote s = "\"" ++ s ++ "\""+ ls = glexeme n+ tbFeats n = (geniShow $ gup n) ++ "!" ++ (geniShow $ gdown n)+ in unwords $ filter (not.null) $ [ gnname x, gaconstrstr, gtypestr x, glexstr x, tbFeats x ]++instance (GeniShow a) => GeniShow [a] where+ geniShow = squares . unwords . (map geniShow)++instance (GeniShow a) => GeniShow (Tree a) where+ geniShow t =+ let treestr i (Node a l) =+ spaces i ++ geniShow a +++ case (l,i) of+ ([], 0) -> "{}"+ ([], _) -> ""+ (_, _) -> "{\n" ++ (unlines $ map next l) ++ spaces i ++ "}"+ where next = treestr (i+1)+ --+ spaces i = take i $ repeat ' '+ in treestr 0 t++instance GeniShow TagElem where+ geniShow te =+ "\n% ------------------------- " ++ idname te+ ++ "\n" ++ (ttreename te) ++ ":" ++ (idname te)+ ++ " " ++ (geniShow.tinterface $ te)+ ++ " " ++ (geniShow.ttype $ te)+ ++ "\n" ++ (geniShow.ttree $ te)+ ++ "\n" ++ geniShowKeyword "semantics" "" ++ (geniShow.tsemantics $ te)++instance (GeniShow a) => GeniShow (Ttree a) where+ geniShow tt =+ "\n% ------------------------- " ++ pidname tt+ ++ "\n" ++ (pfamily tt) ++ ":" ++ (pidname tt)+ ++ " " ++ (parens $ (unwords $ map geniShow $ params tt)+ ++ " ! "+ ++ (unwords $ map geniShow $ pinterface tt))+ ++ " " ++ (geniShow.ptype $ tt)+ ++ "\n" ++ (geniShow.tree $ tt)+ ++ (case psemantics tt of+ Nothing -> ""+ Just psem -> "\n" ++ geniShowKeyword "semantics" (geniShow psem))+ ++ "\n" ++ geniShowKeyword "trace" (squares.unwords.ptrace $ tt)++instance GeniShow TestCase where+ geniShow (TestCase { tcName = name+ , tcExpected = sentences+ , tcOutputs = outputs+ , tcSemString = semStr+ , tcSem = sem }) =+ unlines $ [ name, semS ]+ ++ map (geniShowKeyword "sentence" . squares) sentences+ ++ (concat.prettify.map outStuff $ outputs)+ where+ semS = if null semStr then geniShowSemInput sem "" else semStr+ prettify = if all (Map.null . snd) outputs then id else map ("":)+ gshowTrace ((k1,k2),ts) =+ geniShowKeyword "trace" . squares . showString (k1 ++ " " ++ k2 ++ " ! " ++ unwords ts) $ ""+ outStuff (o,ds) =+ [ geniShowKeyword "output" . squares $ o ]+ ++ (map gshowTrace $ Map.toList ds)+++parens, squares :: String -> String+parens s = "(" ++ s ++ ")"+squares s = "[" ++ s ++ "]"++geniShowKeyword :: String -> ShowS+geniShowKeyword k = showString k . showChar ':'++geniShowSemInput :: SemInput -> ShowS+geniShowSemInput (sem,icons,lcons) =+ let withConstraints lit =+ case concat [ cs | (p,cs) <- lcons, p == lit ] of+ [] -> geniShow lit+ cs -> geniShow lit ++ (squares . unwords $ cs)+ semStuff = geniShowKeyword "semantics" . squares+ . (showString . unwords . map withConstraints $ sem)+ idxStuff = geniShowKeyword "idxconstraints"+ . (showString . geniShow $ icons) . squares+ in semStuff . (if null icons then id else showChar '\n' . idxStuff)
− src/NLP/GenI/GeniShow.lhs
@@ -1,185 +0,0 @@-% GenI surface realiser-% Copyright (C) 2005 Carlos Areces and Eric Kow-%-% This program is free software; you can redistribute it and/or-% modify it under the terms of the GNU General Public License-% as published by the Free Software Foundation; either version 2-% of the License, or (at your option) any later version.-%-% This program is distributed in the hope that it will be useful,-% but WITHOUT ANY WARRANTY; without even the implied warranty of-% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the-% GNU General Public License for more details.-%-% You should have received a copy of the GNU General Public License-% along with this program; if not, write to the Free Software-% Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.--The GeniShow module provides specialised functions for visualising tree data.--% -----------------------------------------------------------------------\section{GeniShow}-% ------------------------------------------------------------------------We need to be able to dump some of GenI's data structures into a simple-text format we call GeniHand.--There are at leaste two uses for this, one is that it allows us to-interrupt the debugging process, dump everything to file, muck around-with the trees and then pick up where we left off.--The other use is to make large grammars faster to load. We don't actually do-this anymore, mind you, but it's nice to have the option. The idea is to take-a massive XML grammar, parse it to a set of TagElems and then write these back-in the lighter syntax. It's not that XML is inherently less efficient to parse-than the handwritten syntax, just that writing an efficient parser for XML-based format is more annoying, so I stuck with HaXml to make my life easy.-Unfortunately, HaXml seems to have some kind of space leak.--\begin{code}-module NLP.GenI.GeniShow-where-\end{code}--\ignore{-\begin{code}-import Data.Tree-import Data.List(intersperse, isPrefixOf)-import qualified Data.Map as Map--import NLP.GenI.Tags- ( TagElem, idname,- tsemantics, ttree, tinterface, ttype, ttreename,- )-import NLP.GenI.Btypes (GeniVal(GConst), AvPair(..), Ptype(..),- Ttree(params, pidname, pfamily, pinterface, ptype, tree, psemantics, ptrace),- GNode(..), GType(..),- SemInput, Pred,- TestCase(..),- )-\end{code}-}--\begin{code}-class GeniShow a where- geniShow :: a -> String--instance GeniShow Ptype where- geniShow Initial = "initial"- geniShow Auxiliar = "auxiliary"- geniShow _ = ""--instance GeniShow AvPair where- geniShow (AvPair a v) = a ++ ":" ++ geniShow v--instance GeniShow GeniVal where- geniShow (GConst xs) = concat $ intersperse "|" xs- geniShow x = show x--instance GeniShow Pred where- geniShow (h, p, l) =- showh ++ geniShow p ++ "(" ++ unwords (map geniShow l) ++ ")"- where- hideh (GConst [x]) = "genihandle" `isPrefixOf` x- hideh _ = False- showh = if hideh h then "" else geniShow h ++ ":"--instance GeniShow GNode where- geniShow x =- let gaconstrstr = case (gaconstr x, gtype x) of- (True, Other) -> "aconstr:noadj"- _ -> ""- gtypestr n = case (gtype n) of- Subs -> "type:subst"- Foot -> "type:foot"- Lex -> if ganchor n && (null.glexeme) n- then "type:anchor" else "type:lex"- _ -> ""- glexstr n =- if null ls then ""- else concat $ intersperse "|" $ map quote ls- where quote s = "\"" ++ s ++ "\""- ls = glexeme n- tbFeats n = (geniShow $ gup n) ++ "!" ++ (geniShow $ gdown n)- in unwords $ filter (not.null) $ [ gnname x, gaconstrstr, gtypestr x, glexstr x, tbFeats x ]--instance (GeniShow a) => GeniShow [a] where- geniShow = squares . unwords . (map geniShow)--instance (GeniShow a) => GeniShow (Tree a) where- geniShow t =- let treestr i (Node a l) =- spaces i ++ geniShow a ++- case (l,i) of- ([], 0) -> "{}"- ([], _) -> ""- (_, _) -> "{\n" ++ (unlines $ map next l) ++ spaces i ++ "}"- where next = treestr (i+1)- --- spaces i = take i $ repeat ' '- in treestr 0 t--instance GeniShow TagElem where- geniShow te =- "\n% ------------------------- " ++ idname te- ++ "\n" ++ (ttreename te) ++ ":" ++ (idname te)- ++ " " ++ (geniShow.tinterface $ te)- ++ " " ++ (geniShow.ttype $ te)- ++ "\n" ++ (geniShow.ttree $ te)- ++ "\n" ++ geniShowKeyword "semantics" "" ++ (geniShow.tsemantics $ te)--instance (GeniShow a) => GeniShow (Ttree a) where- geniShow tt =- "\n% ------------------------- " ++ pidname tt- ++ "\n" ++ (pfamily tt) ++ ":" ++ (pidname tt)- ++ " " ++ (parens $ (unwords $ map geniShow $ params tt)- ++ " ! "- ++ (unwords $ map geniShow $ pinterface tt))- ++ " " ++ (geniShow.ptype $ tt)- ++ "\n" ++ (geniShow.tree $ tt)- ++ (case psemantics tt of- Nothing -> ""- Just psem -> "\n" ++ geniShowKeyword "semantics" (geniShow psem))- ++ "\n" ++ geniShowKeyword "trace" (squares.unwords.ptrace $ tt)--instance GeniShow TestCase where- geniShow (TestCase { tcName = name- , tcExpected = sentences- , tcOutputs = outputs- , tcSemString = semStr- , tcSem = sem }) =- unlines $ [ name, semS ]- ++ map (geniShowKeyword "sentence" . squares) sentences- ++ (concat.prettify.map outStuff $ outputs)- where- semS = if null semStr then geniShowSemInput sem "" else semStr- prettify = if all (Map.null . snd) outputs then id else map ("":)- gshowTrace ((k1,k2),ts) =- geniShowKeyword "trace" . squares . showString (k1 ++ " " ++ k2 ++ " ! " ++ unwords ts) $ ""- outStuff (o,ds) =- [ geniShowKeyword "output" . squares $ o ]- ++ (map gshowTrace $ Map.toList ds)---parens, squares :: String -> String-parens s = "(" ++ s ++ ")"-squares s = "[" ++ s ++ "]"--geniShowKeyword :: String -> ShowS-geniShowKeyword k = showString k . showChar ':'--geniShowSemInput :: SemInput -> ShowS-geniShowSemInput (sem,icons,lcons) =- let withConstraints lit =- case concat [ cs | (p,cs) <- lcons, p == lit ] of- [] -> geniShow lit- cs -> geniShow lit ++ (squares . unwords $ cs)- semStuff = geniShowKeyword "semantics" . squares- . (showString . unwords . map withConstraints $ sem)- idxStuff = geniShowKeyword "idxconstraints"- . (showString . geniShow $ icons) . squares- in semStuff . (if null icons then id else showChar '\n' . idxStuff)-\end{code}--\include{src/NLP/GenI/GraphvizShow.lhs}-\include{src/NLP/GenI/HsShow.lhs}
src/NLP/GenI/Graphviz.hs view
@@ -34,7 +34,9 @@ import Control.Monad(when) import Data.List(intersperse) import Data.Tree-import System.IO(hPutStrLn, hClose)+import System.IO ( hClose )+import System.IO.UTF8+import Prelude hiding ( writeFile ) import System.Exit(ExitCode) import NLP.GenI.SysGeni(waitForProcess, runInteractiveProcess)@@ -200,7 +202,7 @@ let dotArgs' = ["-Gfontname=courier", "-Nfontname=courier", "-Efontname=courier", - "-Gcharset=latin1", -- FIXME: should really output UTF-8 instead+ "-Gcharset=utf-8", "-Tpng", "-o" ++ outputFile ] dotArgs = dotArgs' ++ (if (null dotFile) then [] else [dotFile]) -- putStrLn ("sending to graphviz:\n" ++ dot)
+ src/NLP/GenI/GraphvizShow.hs view
@@ -0,0 +1,199 @@+-- GenI surface realiser+-- Copyright (C) 2009 Eric Kow+--+-- This program is free software; you can redistribute it and/or+-- modify it under the terms of the GNU General Public License+-- as published by the Free Software Foundation; either version 2+-- of the License, or (at your option) any later version.+--+-- This program is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+-- GNU General Public License for more details.+--+-- You should have received a copy of the GNU General Public License+-- along with this program; if not, write to the Free Software+-- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.++{-# LANGUAGE FlexibleInstances, TypeSynonymInstances, FlexibleContexts #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-- | Outputting core GenI data to graphviz.+module NLP.GenI.GraphvizShow+where++import Data.List(intersperse,nub)+import Data.List.Split (wordsBy)+import Data.Maybe(listToMaybe)++import NLP.GenI.Tags+ ( TagElem, TagDerivation, idname,+ tsemantics, ttree,+ DerivationStep(..),+ )+import NLP.GenI.Btypes (GeniVal(GConst), AvPair(..),+ GNode(..), GType(..), Flist,+ isConst,+ showSem,+ )+import NLP.GenI.Graphviz+ ( gvUnlines, gvNewline+ , GraphvizShow(graphvizShowAsSubgraph, graphvizLabel, graphvizParams)+ , GraphvizShowNode(graphvizShowNode)+ , GraphvizShowString(graphvizShow)+ , gvNode, gvEdge, gvShowTree+ )++-- ----------------------------------------------------------------------+-- For GraphViz+-- ----------------------------------------------------------------------++type GvHighlighter a = a -> (a, Maybe String)++nullHighlighter :: GvHighlighter GNode+nullHighlighter a = (a,Nothing)++instance GraphvizShow Bool TagElem where+ graphvizShowAsSubgraph sf = graphvizShowAsSubgraph (sf, nullHighlighter)+ graphvizLabel sf = graphvizLabel (sf, nullHighlighter )+ graphvizParams sf = graphvizParams (sf, nullHighlighter)+++instance GraphvizShow (Bool, GvHighlighter GNode) TagElem where+ graphvizShowAsSubgraph (sf,hfn) prefix te =+ (gvShowTree (\_->[]) sf (prefix ++ "DerivedTree0") $+ fmap hfn $ ttree te)++ graphvizLabel _ te =+ -- we display the tree semantics as the graph label+ let treename = "name: " ++ (idname te)+ semlist = "semantics: " ++ (showSem $ tsemantics te)+ in gvUnlines [ treename, semlist ]++ graphvizParams _ _ =+ [ "fontsize = 10", "ranksep = 0.3"+ , "node [fontsize=10]"+ , "edge [fontsize=10 arrowhead=none]" ]++-- ----------------------------------------------------------------------+-- Helper functions for the TagElem GraphvizShow instance+-- ----------------------------------------------------------------------++instance GraphvizShowNode (Bool) (GNode, Maybe String) where+ -- compact -> (node, mcolour) -> String+ graphvizShowNode detailed prefix (gn, mcolour) =+ let -- attributes+ filledParam = ("style", "filled")+ fillcolorParam = ("fillcolor", "lemonchiffon")+ shapeRecordParam = ("shape", "record")+ shapePlaintextParam = ("shape", "plaintext")+ --+ colorParams = case mcolour of+ Nothing -> []+ Just c -> [ ("fontcolor", c) ]+ shapeParams = if detailed+ then [ shapeRecordParam, filledParam, fillcolorParam ]+ else [ shapePlaintextParam ]+ -- content+ stub = showGnStub gn+ extra = showGnDecorations gn+ summary = if null extra then stub+ else "{" ++ stub ++ "|" ++ extra ++ "}"+ --+ body = if not detailed then graphvizShow_ gn+ else "{" ++ summary+ ++ (barAnd.showFs $ gup gn)+ ++ (maybeShow (barAnd.showFs) $ gdown gn)+ ++ "}"+ where barAnd x = "|" ++ x+ showFs = gvUnlines . (map graphvizShow_)+ in gvNode prefix body (shapeParams ++ colorParams)++instance GraphvizShowString () GNode where+ graphvizShow () gn =+ let stub = showGnStub gn+ extra = showGnDecorations gn+ in stub ++ extra++instance GraphvizShowString () AvPair where+ graphvizShow () (AvPair a v) = a ++ ":" ++ graphvizShow_ v++instance GraphvizShowString () GeniVal where+ graphvizShow () (GConst x) = concat $ intersperse " ! " x+ graphvizShow () x = show x++showGnDecorations :: GNode -> String+showGnDecorations gn =+ case gtype gn of+ Subs -> "↓"+ Foot -> "*"+ _ -> if gaconstr gn then "ᴺᴬ" else ""++showGnStub :: GNode -> String+showGnStub gn =+ let cat = case getGnVal gup "cat" gn of+ Nothing -> ""+ Just v -> graphvizShow_ v+ --+ getIdx f =+ case getGnVal f "idx" gn of+ Nothing -> ""+ Just v -> if isConst v then graphvizShow_ v else ""+ idxT = getIdx gup+ idxB = getIdx gdown+ idx = idxT ++ (maybeShow_ "." idxB)+ --+ lexeme = concat $ intersperse "!" $ glexeme gn+ in concat $ intersperse ":" $ filter (not.null) [ cat, idx, lexeme ]++getGnVal :: (GNode -> Flist) -> String -> GNode -> Maybe GeniVal+getGnVal getFeat attr gn =+ listToMaybe [ v | AvPair a v <- getFeat gn, a == attr ]++-- | Apply fn to s if s is not null+maybeShow :: ([a] -> String) -> [a] -> String+maybeShow fn s = if null s then "" else fn s+-- | Prefix a string if it is not null+maybeShow_ :: String -> String -> String+maybeShow_ prefix s = maybeShow (prefix++) s++graphvizShow_ :: (GraphvizShowString () a) => a -> String+graphvizShow_ = graphvizShow ()++-- ----------------------------------------------------------------------+-- Derivation tree+-- ----------------------------------------------------------------------++graphvizShowDerivation :: TagDerivation -> String+graphvizShowDerivation deriv =+ if (null histNodes)+ then ""+ else " node [ shape = plaintext ];\n"+ ++ (concatMap showHistNode histNodes)+ ++ (concatMap graphvizShowDerivation' deriv)+ where showHistNode n = gvNode (gvDerivationLab n) (label n) []+ label n = case wordsBy (== ':') n of+ name:fam:tree:_ -> name ++ ":" ++ fam ++ gvNewline ++ tree+ _ -> n ++ " (geni/gv ERROR)"+ histNodes = reverse $ nub $ concatMap (\ (DerivationStep _ c p _) -> [c,p]) deriv++graphvizShowDerivation' :: DerivationStep -> String+graphvizShowDerivation' (DerivationStep substadj child parent _) =+ gvEdge (gvDerivationLab parent) (gvDerivationLab child) "" p+ where p = if substadj == 'a' then [("style","dashed")] else []+++gvDerivationLab :: String -> String+gvDerivationLab xs = "Derivation" ++ gvMunge xs++newlineToSlashN :: Char -> String+newlineToSlashN '\n' = gvNewline+newlineToSlashN x = [x]++-- | Node names can't have hyphens in them and newlines within the node+-- labels should be represented literally as @\\n@.+gvMunge :: String -> String+gvMunge = map dot2x . filter (/= ':') . filter (/= '-')++dot2x :: Char -> Char+dot2x '.' = 'x'+dot2x c = c
− src/NLP/GenI/GraphvizShow.lhs
@@ -1,222 +0,0 @@-% GenI surface realiser-% Copyright (C) 2005 Carlos Areces and Eric Kow-%-% This program is free software; you can redistribute it and/or-% modify it under the terms of the GNU General Public License-% as published by the Free Software Foundation; either version 2-% of the License, or (at your option) any later version.-%-% This program is distributed in the hope that it will be useful,-% but WITHOUT ANY WARRANTY; without even the implied warranty of-% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the-% GNU General Public License for more details.-%-% You should have received a copy of the GNU General Public License-% along with this program; if not, write to the Free Software-% Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.--\section{GraphvizShow}--Outputting core GenI data to graphviz.--\begin{code}-{-# LANGUAGE FlexibleInstances, TypeSynonymInstances, FlexibleContexts #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}-module NLP.GenI.GraphvizShow-where-\end{code}--\ignore{-\begin{code}-import Data.List(intersperse,nub)-import Data.List.Split (wordsBy)-import Data.Maybe(listToMaybe)--import NLP.GenI.Tags- ( TagElem, TagDerivation, idname,- tsemantics, ttree,- DerivationStep(..),- )-import NLP.GenI.Btypes (GeniVal(GConst), AvPair(..),- GNode(..), GType(..), Flist,- isConst,- showSem,- )-import NLP.GenI.Graphviz- ( gvUnlines, gvNewline- , GraphvizShow(graphvizShowAsSubgraph, graphvizLabel, graphvizParams)- , GraphvizShowNode(graphvizShowNode)- , GraphvizShowString(graphvizShow)- , gvNode, gvEdge, gvShowTree- )--\end{code}-}--% -----------------------------------------------------------------------\section{For GraphViz}-% ------------------------------------------------------------------------\begin{code}-type GvHighlighter a = a -> (a, Maybe String)--nullHighlighter :: GvHighlighter GNode-nullHighlighter a = (a,Nothing)--instance GraphvizShow Bool TagElem where- graphvizShowAsSubgraph sf = graphvizShowAsSubgraph (sf, nullHighlighter)- graphvizLabel sf = graphvizLabel (sf, nullHighlighter )- graphvizParams sf = graphvizParams (sf, nullHighlighter)---instance GraphvizShow (Bool, GvHighlighter GNode) TagElem where- graphvizShowAsSubgraph (sf,hfn) prefix te =- (gvShowTree (\_->[]) sf (prefix ++ "DerivedTree0") $- fmap hfn $ ttree te)-- graphvizLabel _ te =- -- we display the tree semantics as the graph label- let treename = "name: " ++ (idname te)- semlist = "semantics: " ++ (showSem $ tsemantics te)- in gvUnlines [ treename, semlist ]-- graphvizParams _ _ =- [ "fontsize = 10", "ranksep = 0.3"- , "node [fontsize=10]"- , "edge [fontsize=10 arrowhead=none]" ]-\end{code}--Helper functions for the TagElem GraphvizShow instance--\section{GNode - GraphvizShow}--\begin{code}-instance GraphvizShowNode (Bool) (GNode, Maybe String) where- -- compact -> (node, mcolour) -> String- graphvizShowNode detailed prefix (gn, mcolour) =- let -- attributes- filledParam = ("style", "filled")- fillcolorParam = ("fillcolor", "lemonchiffon")- shapeRecordParam = ("shape", "record")- shapePlaintextParam = ("shape", "plaintext")- --- colorParams = case mcolour of- Nothing -> []- Just c -> [ ("fontcolor", c) ]- shapeParams = if detailed- then [ shapeRecordParam, filledParam, fillcolorParam ]- else [ shapePlaintextParam ]- -- content- stub = showGnStub gn- extra = showGnDecorations gn- summary = if null extra then stub- else "{" ++ stub ++ "|" ++ extra ++ "}"- --- body = if not detailed then graphvizShow_ gn- else "{" ++ summary- ++ (barAnd.showFs $ gup gn)- ++ (maybeShow (barAnd.showFs) $ gdown gn)- ++ "}"- where barAnd x = "|" ++ x- showFs = gvUnlines . (map graphvizShow_)- in gvNode prefix body (shapeParams ++ colorParams)-\end{code}--\begin{code}-instance GraphvizShowString () GNode where- graphvizShow () gn =- let stub = showGnStub gn- extra = showGnDecorations gn- in stub ++ maybeShow_ " " extra--instance GraphvizShowString () AvPair where- graphvizShow () (AvPair a v) = a ++ ":" ++ graphvizShow_ v--instance GraphvizShowString () GeniVal where- graphvizShow () (GConst x) = concat $ intersperse " ! " x- graphvizShow () x = show x--showGnDecorations :: GNode -> String-showGnDecorations gn =- case gtype gn of- Subs -> "!"- Foot -> "*"- _ -> if (gaconstr gn) then "#" else ""--showGnStub :: GNode -> String-showGnStub gn =- let cat = case getGnVal gup "cat" gn of- Nothing -> ""- Just v -> graphvizShow_ v- --- getIdx f =- case getGnVal f "idx" gn of- Nothing -> ""- Just v -> if isConst v then graphvizShow_ v else ""- idxT = getIdx gup- idxB = getIdx gdown- idx = idxT ++ (maybeShow_ "." idxB)- --- lexeme = concat $ intersperse "!" $ glexeme gn- in concat $ intersperse ":" $ filter (not.null) [ cat, idx, lexeme ]--getGnVal :: (GNode -> Flist) -> String -> GNode -> Maybe GeniVal-getGnVal getFeat attr gn =- listToMaybe [ v | AvPair a v <- getFeat gn, a == attr ]---- | Apply fn to s if s is not null-maybeShow :: ([a] -> String) -> [a] -> String-maybeShow fn s = if null s then "" else fn s--- | Prefix a string if it is not null-maybeShow_ :: String -> String -> String-maybeShow_ prefix s = maybeShow (prefix++) s--graphvizShow_ :: (GraphvizShowString () a) => a -> String-graphvizShow_ = graphvizShow ()-\end{code}--% -----------------------------------------------------------------------\section{Derivation tree}-% ------------------------------------------------------------------------\begin{code}-graphvizShowDerivation :: TagDerivation -> String-graphvizShowDerivation deriv =- if (null histNodes)- then ""- else " node [ shape = plaintext ];\n"- ++ (concatMap showHistNode histNodes)- ++ (concatMap graphvizShowDerivation' deriv)- where showHistNode n = gvNode (gvDerivationLab n) (label n) []- label n = case wordsBy (== ':') n of- name:fam:tree:_ -> name ++ ":" ++ fam ++ gvNewline ++ tree- _ -> n ++ " (geni/gv ERROR)"- histNodes = reverse $ nub $ concatMap (\ (DerivationStep _ c p _) -> [c,p]) deriv-\end{code}--\begin{code}-graphvizShowDerivation' :: DerivationStep -> String-graphvizShowDerivation' (DerivationStep substadj child parent _) =- gvEdge (gvDerivationLab parent) (gvDerivationLab child) "" p- where p = if substadj == 'a' then [("style","dashed")] else []-\end{code}--We have a couple of functions to help massage our data into Graphviz input-format: node names can't have hyphens in them and newlines within the node-labels should be represented literally as \verb$\n$.--\begin{code}-gvDerivationLab :: String -> String-gvDerivationLab xs = "Derivation" ++ gvMunge xs--newlineToSlashN :: Char -> String-newlineToSlashN '\n' = gvNewline-newlineToSlashN x = [x]--gvMunge :: String -> String-gvMunge = map dot2x . filter (/= ':') . filter (/= '-')--dot2x :: Char -> Char-dot2x '.' = 'x'-dot2x c = c-\end{code}
src/NLP/GenI/Gui.lhs view
@@ -625,13 +625,14 @@ , hfloatRight $ widget saveBt ] \end{code} +% --------------------------------------------------------------------+\section{Debugging} \label{sec:gui:debugger}+% --------------------------------------------------------------------+ Instead of going directly to the results window, you could instead use the interactive debugger which GenI provides. The debugger shows a separate tab-for each phase in surfuce realisation (lexical selection, filtering, building).-The building phase has a parameterisable GUI, which means that if you wanted to-develop a new surface realisation algorithm for GenI, you could also extend the-debugger GUI to go with it.+for each phase in surface realisation (lexical selection, filtering, building). \begin{center} \includegraphics[width=0.47\textwidth]{hcar/GenI-debugger-screenshot.jpg}@@ -686,7 +687,50 @@ -- display all tabs if we are not told to pause on lex selection when (not pauseOnLex) (step2 cand) \end{code}- ++\subsection{Stepping through the debugger}++The interactive debugger can have a diffrent GUI for each realisation algorithm.+Here we will discuss the interface for the Simple 2-Phase algorithm which \geni+uses by default. The interfaces for other algorithms are likely to very similar.++\begin{center}+\includegraphics[width=0.47\textwidth]{images/debugger-features.png}+\end{center}++The debugger allows you to step through chart generation. Using the 'Step by'+button, you can walk through an arbitrary number of steps, where each step+consists in pulling one item of the agenda, combining it with the chart and+putting some of the results back on to the agenda (or the trash, or results+pile as the case may be). New chart items produced on each step typically have+one of their nodes highlighted in red. This indicates that the node was the+site of the most recent ``event''. For example in the substitution phase, the+red node indicates where the substitution operation was performed; whereas in+the adjunction phase, it could either indicate where adjunction was performed+or where a null-adjunction constraint was applied.++If you select the ``show features'' checkbox, all nodes in the chart item will+be expanded to reveal the underlying feature structures. The components of this+expanded representation are segmented into the following boxes:++\vspace{1em}+\begin{tabular}{ll}+\begin{minipage}{0.10\textwidth}+\includegraphics[width=\textwidth]{images/debugger-features-focus.png}+\end{minipage} &+\begin{minipage}{0.70\textwidth}+\begin{enumerate}+\item Summary: here, \verb!n:j.m! indicates that the category is \verb!n!,+ that the top \verb!idx! feature is associated with \verb'j' and the+ bottom one with \verb!m!.+\item Decorations: here, $\downarrow$ indicates that this is a TAG substitution+ node, following the usual conventions in the literature.+\item The top feature structure+\item The bottom feature structure+\end{enumerate}+\end{minipage} \\+\end{tabular}+ % -------------------------------------------------------------------- \section{Tree browser} \label{sec:treebrowser_gui}