forked from GitHub/gf-core
Added Graphviz module for graphviz stuff. Move a lot of utility functions to GF.Data.Utilities.
This commit is contained in:
bringert
@@ -5,9 +5,9 @@
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date: 2005/09/12 16:10:23 $
|
||||
-- > CVS $Date: 2005/09/14 15:17:29 $
|
||||
-- > CVS $Author: bringert $
|
||||
-- > CVS $Revision: 1.2 $
|
||||
-- > CVS $Revision: 1.3 $
|
||||
--
|
||||
-- Approximates CFGs with finite state networks.
|
||||
-----------------------------------------------------------------------------
|
||||
@@ -16,6 +16,7 @@ module GF.Speech.CFGToFiniteState (cfgToFA, makeSimpleRegular) where
|
||||
|
||||
import Data.List
|
||||
|
||||
import GF.Data.Utilities
|
||||
import GF.Formalism.CFG
|
||||
import GF.Formalism.Utilities (Symbol(..), mapSymbol, filterCats, symbol, NameProfile(..))
|
||||
import GF.Conversion.Types
|
||||
@@ -160,13 +161,3 @@ equivalenceClasses r = equivalenceClasses_ (nub (map fst r)) r
|
||||
equivalenceClasses_ (x:xs) r = (x:ys):equivalenceClasses_ zs r
|
||||
where (ys,zs) = partition (isRelatedTo r x) xs
|
||||
|
||||
--
|
||||
-- * Utilities
|
||||
--
|
||||
|
||||
foldFuns :: [a -> a] -> a -> a
|
||||
foldFuns fs x = foldl (flip ($)) x fs
|
||||
|
||||
safeInit :: [a] -> [a]
|
||||
safeInit [] = []
|
||||
safeInit xs = init xs
|
||||
@@ -5,9 +5,9 @@
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date: 2005/09/12 22:32:24 $
|
||||
-- > CVS $Date: 2005/09/14 15:17:29 $
|
||||
-- > CVS $Author: bringert $
|
||||
-- > CVS $Revision: 1.6 $
|
||||
-- > CVS $Revision: 1.7 $
|
||||
--
|
||||
-- A simple finite state network module.
|
||||
-----------------------------------------------------------------------------
|
||||
@@ -19,12 +19,14 @@ module GF.Speech.FiniteState (FA, State,
|
||||
newState, newTransition,
|
||||
mapStates, mapTransitions,
|
||||
moveLabelsToNodes, minimize,
|
||||
prGraphGraphviz) where
|
||||
prFAGraphviz) where
|
||||
|
||||
import Data.List
|
||||
import Data.Maybe (fromJust)
|
||||
|
||||
import Debug.Trace
|
||||
import GF.Data.Utilities
|
||||
import qualified GF.Visualization.Graphviz as Dot
|
||||
|
||||
|
||||
data FA a b = FA (Graph a b) State [State]
|
||||
|
||||
@@ -75,14 +77,15 @@ minimize = onGraph mimimizeGr1
|
||||
moveLabelsToNodes :: Eq a => FA () (Maybe a) -> FA (Maybe a) ()
|
||||
moveLabelsToNodes = onGraph moveLabelsToNodes_
|
||||
|
||||
prGraphGraphviz :: FA String String -> String
|
||||
prGraphGraphviz (FA (Graph _ ns es) _ _) =
|
||||
"digraph {\n" ++ unlines (map prNode ns)
|
||||
++ "\n"
|
||||
++ unlines (map prEdge es)
|
||||
++ "\n}\n"
|
||||
where prNode (n,l) = show n ++ " [label = " ++ show l ++ "]"
|
||||
prEdge (f,t,l) = show f ++ " -> " ++ show t ++ " [label = " ++ show l ++ "]"
|
||||
prFAGraphviz :: FA String String -> String
|
||||
prFAGraphviz = Dot.prGraphviz . mkGraphviz
|
||||
where
|
||||
mkGraphviz (FA (Graph _ ns es) s f) = Dot.Graph Dot.Directed [] (map mkNode ns) (map mkEdge es)
|
||||
where mkNode (n,l) = Dot.Node (show n) attrs
|
||||
where attrs = [("label",l)]
|
||||
++ if n == s then [("shape","box")] else []
|
||||
++ if n `elem` f then [("style","bold")] else []
|
||||
mkEdge (x,y,l) = Dot.Edge (show x) (show y) [("label",l)]
|
||||
|
||||
--
|
||||
-- * Graphs
|
||||
@@ -165,12 +168,5 @@ mimimizeGr2 = id
|
||||
removeDuplicateEdges :: Ord b => Graph a b -> Graph a b
|
||||
removeDuplicateEdges (Graph c ns es) = Graph c ns (sortNub es)
|
||||
|
||||
|
||||
|
||||
|
||||
--
|
||||
-- * Utilities
|
||||
--
|
||||
|
||||
sortNub :: Ord a => [a] -> [a]
|
||||
sortNub = map head . group . sort
|
||||
reverseGraph :: Graph a b -> Graph a b
|
||||
reverseGraph (Graph c ns es) = Graph c ns [ (t,f,l) | (f,t,l) <- es ]
|
||||
|
||||
@@ -5,9 +5,9 @@
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date: 2005/09/07 14:21:30 $
|
||||
-- > CVS $Date: 2005/09/14 15:17:29 $
|
||||
-- > CVS $Author: bringert $
|
||||
-- > CVS $Revision: 1.20 $
|
||||
-- > CVS $Revision: 1.21 $
|
||||
--
|
||||
-- This module prints a CFG as a Nuance GSL 2.0 grammar.
|
||||
--
|
||||
@@ -17,6 +17,7 @@
|
||||
|
||||
module GF.Speech.PrGSL (gslPrinter) where
|
||||
|
||||
import GF.Data.Utilities
|
||||
import GF.Speech.SRG
|
||||
import GF.Infra.Ident
|
||||
|
||||
|
||||
@@ -5,9 +5,9 @@
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date: 2005/09/07 14:21:30 $
|
||||
-- > CVS $Date: 2005/09/14 15:17:29 $
|
||||
-- > CVS $Author: bringert $
|
||||
-- > CVS $Revision: 1.14 $
|
||||
-- > CVS $Revision: 1.15 $
|
||||
--
|
||||
-- This module prints a CFG as a JSGF grammar.
|
||||
--
|
||||
@@ -19,13 +19,14 @@
|
||||
|
||||
module GF.Speech.PrJSGF (jsgfPrinter) where
|
||||
|
||||
import GF.Speech.SRG
|
||||
import GF.Infra.Ident
|
||||
import GF.Conversion.Types
|
||||
import GF.Data.Utilities
|
||||
import GF.Formalism.CFG
|
||||
import GF.Formalism.Utilities (Symbol(..))
|
||||
import GF.Conversion.Types
|
||||
import GF.Infra.Ident
|
||||
import GF.Infra.Print
|
||||
import GF.Infra.Option
|
||||
import GF.Speech.SRG
|
||||
|
||||
jsgfPrinter :: Ident -- ^ Grammar name
|
||||
-> Options -> CGrammar -> String
|
||||
@@ -45,7 +46,7 @@ prJSGF (SRG{grammarName=name,startCat=start,origStartCat=origStart,rules=rs})
|
||||
. showString "public <MAIN> = " . prCat start . showChar ';' . nl . nl
|
||||
prRule (SRGRule cat origCat rhs) =
|
||||
comments [origCat] . nl
|
||||
. prCat cat . showString " = " . join " | " (map prAlt rhs) . nl
|
||||
. prCat cat . showString " = " . joinS " | " (map prAlt rhs) . nl
|
||||
prAlt rhs | null rhs' = showString "<NULL>"
|
||||
| otherwise = wrap "(" (unwordsS (map prSymbol rhs')) ")"
|
||||
where rhs' = rmPunct rhs
|
||||
|
||||
@@ -5,9 +5,9 @@
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date: 2005/09/13 08:20:20 $
|
||||
-- > CVS $Date: 2005/09/14 15:17:30 $
|
||||
-- > CVS $Author: bringert $
|
||||
-- > CVS $Revision: 1.8 $
|
||||
-- > CVS $Revision: 1.9 $
|
||||
--
|
||||
-- This module converts a CFG to an SLF finite-state network
|
||||
-- for use with the ATK recognizer. The SLF format is described
|
||||
@@ -21,17 +21,17 @@
|
||||
module GF.Speech.PrSLF (slfPrinter,slfGraphvizPrinter,
|
||||
faGraphvizPrinter,regularPrinter) where
|
||||
|
||||
import GF.Speech.SRG
|
||||
import GF.Speech.TransformCFG
|
||||
import GF.Speech.CFGToFiniteState
|
||||
import GF.Speech.FiniteState
|
||||
import GF.Infra.Ident
|
||||
|
||||
import GF.Data.Utilities
|
||||
import GF.Conversion.Types
|
||||
import GF.Formalism.CFG
|
||||
import GF.Formalism.Utilities (Symbol(..),symbol)
|
||||
import GF.Conversion.Types
|
||||
import GF.Infra.Print
|
||||
import GF.Infra.Ident
|
||||
import GF.Infra.Option
|
||||
import GF.Infra.Print
|
||||
import GF.Speech.CFGToFiniteState
|
||||
import GF.Speech.FiniteState
|
||||
import GF.Speech.SRG
|
||||
import GF.Speech.TransformCFG
|
||||
|
||||
import Data.Char (toUpper,toLower)
|
||||
import Data.List
|
||||
@@ -54,12 +54,13 @@ slfPrinter name opts cfg = prSLF (automatonToSLF $ moveLabelsToNodes $ cfgToFA n
|
||||
slfGraphvizPrinter :: Ident -- ^ Grammar name
|
||||
-> Options -> CGrammar -> String
|
||||
slfGraphvizPrinter name opts cfg =
|
||||
prGraphGraphviz (mapStates (fromMaybe "") $ mapTransitions (const "") $ moveLabelsToNodes $ cfgToFA name opts cfg)
|
||||
prFAGraphviz (mapStates (fromMaybe "") $ mapTransitions (const "") $ moveLabelsToNodes $ cfgToFA name opts cfg)
|
||||
|
||||
faGraphvizPrinter :: Ident -- ^ Grammar name
|
||||
-> Options -> CGrammar -> String
|
||||
faGraphvizPrinter name opts cfg =
|
||||
prGraphGraphviz (mapStates (const "") $ mapTransitions (fromMaybe "") $ cfgToFA name opts cfg)
|
||||
prFAGraphviz (mapStates (const "") $ mapTransitions (fromMaybe "") $ cfgToFA name opts cfg)
|
||||
|
||||
|
||||
-- | Convert the grammar to a regular grammar and print it in BNF
|
||||
regularPrinter :: CGrammar -> String
|
||||
|
||||
@@ -5,9 +5,9 @@
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date: 2005/09/12 15:46:44 $
|
||||
-- > CVS $Date: 2005/09/14 15:17:30 $
|
||||
-- > CVS $Author: bringert $
|
||||
-- > CVS $Revision: 1.16 $
|
||||
-- > CVS $Revision: 1.17 $
|
||||
--
|
||||
-- Representation of, conversion to, and utilities for
|
||||
-- printing of a general Speech Recognition Grammar.
|
||||
@@ -20,6 +20,7 @@
|
||||
|
||||
module GF.Speech.SRG where
|
||||
|
||||
import GF.Data.Utilities
|
||||
import GF.Infra.Ident
|
||||
import GF.Formalism.CFG
|
||||
import GF.Formalism.Utilities (Symbol(..))
|
||||
@@ -80,29 +81,8 @@ mkCatNames prefix origNames = listToFM (zip origNames names)
|
||||
-- * Utilities for building and printing SRGs
|
||||
--
|
||||
|
||||
nl :: ShowS
|
||||
nl = showChar '\n'
|
||||
|
||||
sp :: ShowS
|
||||
sp = showChar ' '
|
||||
|
||||
wrap :: String -> ShowS -> String -> ShowS
|
||||
wrap o s c = showString o . s . showString c
|
||||
|
||||
concatS :: [ShowS] -> ShowS
|
||||
concatS = foldr (.) id
|
||||
|
||||
unwordsS :: [ShowS] -> ShowS
|
||||
unwordsS = join " "
|
||||
|
||||
unlinesS :: [ShowS] -> ShowS
|
||||
unlinesS = join "\n"
|
||||
|
||||
join :: String -> [ShowS] -> ShowS
|
||||
join glue = concatS . intersperse (showString glue)
|
||||
|
||||
prtS :: Print a => a -> ShowS
|
||||
prtS = showString . prt
|
||||
|
||||
lookupFM_ :: (Ord key, Show key) => FiniteMap key elt -> key -> elt
|
||||
lookupFM_ fm k = lookupWithDefaultFM fm (error $ "Key not found: " ++ show k) k
|
||||
|
||||
prtS :: Print a => a -> ShowS
|
||||
prtS = showString . prt
|
||||
@@ -5,9 +5,9 @@
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date: 2005/09/12 16:10:23 $
|
||||
-- > CVS $Date: 2005/09/14 15:17:30 $
|
||||
-- > CVS $Author: bringert $
|
||||
-- > CVS $Revision: 1.21 $
|
||||
-- > CVS $Revision: 1.22 $
|
||||
--
|
||||
-- This module does some useful transformations on CFGs.
|
||||
--
|
||||
@@ -23,12 +23,13 @@ module GF.Speech.TransformCFG {- (CFRule_, CFRules,
|
||||
removeLeftRecursion,
|
||||
removeEmptyCats, removeIdenticalRules) -} where
|
||||
|
||||
import GF.Infra.Ident
|
||||
import GF.Conversion.Types
|
||||
import GF.Data.Utilities
|
||||
import GF.Formalism.CFG
|
||||
import GF.Formalism.Utilities (Symbol(..), mapSymbol, filterCats, symbol, NameProfile(..))
|
||||
import GF.Conversion.Types
|
||||
import GF.Infra.Print
|
||||
import GF.Infra.Ident
|
||||
import GF.Infra.Option
|
||||
import GF.Infra.Print
|
||||
import GF.Speech.FiniteState
|
||||
|
||||
import Control.Monad
|
||||
@@ -36,8 +37,6 @@ import Data.FiniteMap
|
||||
import Data.List
|
||||
import Data.Maybe (fromJust, fromMaybe)
|
||||
|
||||
import Debug.Trace
|
||||
|
||||
|
||||
-- | not very nice to replace the structured CFCat type with a simple string
|
||||
type CFRule_ = CFRule Cat_ Name Token
|
||||
@@ -135,26 +134,4 @@ anyUsedBy cs (CFRule _ ss _) = any (`elem` cs) (filterCats ss)
|
||||
mkName :: String -> Name
|
||||
mkName n = Name (IC n) []
|
||||
|
||||
--
|
||||
-- * Utilities
|
||||
--
|
||||
|
||||
findSet :: Eq c => c -> [[c]] -> Maybe [c]
|
||||
findSet x = find (x `elem`)
|
||||
|
||||
fix :: Eq a => (a -> a) -> a -> a
|
||||
fix f x = let x' = f x in if x' == x then x else fix f x'
|
||||
|
||||
nothingOrNull :: Maybe [a] -> Bool
|
||||
nothingOrNull Nothing = True
|
||||
nothingOrNull (Just xs) = null xs
|
||||
|
||||
unionAll :: Eq a => [[a]] -> [a]
|
||||
unionAll = nub . concat
|
||||
|
||||
whenMP :: MonadPlus m => Bool -> a -> m a
|
||||
whenMP b x = if b then return x else mzero
|
||||
|
||||
lookup' :: Eq a => a -> [(a,b)] -> b
|
||||
lookup' x = fromJust . lookup x
|
||||
|
||||
|
||||
Reference in New Issue
Block a user