From 136728e336d66349723f882fcd87a2eb8d42903c Mon Sep 17 00:00:00 2001 From: bringert Date: Thu, 10 Nov 2005 15:43:44 +0000 Subject: [PATCH] Prepared for generation of finite automata in C. --- src/GF/Speech/CFGToFiniteState.hs | 6 +++--- src/GF/Speech/FiniteState.hs | 33 ++++++++++++++++--------------- src/GF/Speech/Graph.hs | 17 +++++++++++++--- src/GF/Speech/PrFA.hs | 15 ++++++++++---- src/GF/Speech/PrSLF.hs | 8 ++++---- src/GF/UseGrammar/Custom.hs | 9 ++++++--- 6 files changed, 55 insertions(+), 33 deletions(-) diff --git a/src/GF/Speech/CFGToFiniteState.hs b/src/GF/Speech/CFGToFiniteState.hs index 590fd1c6d..5a72f548a 100644 --- a/src/GF/Speech/CFGToFiniteState.hs +++ b/src/GF/Speech/CFGToFiniteState.hs @@ -5,9 +5,9 @@ -- Stability : (stable) -- Portability : (portable) -- --- > CVS $Date: 2005/10/26 17:13:13 $ +-- > CVS $Date: 2005/11/10 16:43:44 $ -- > CVS $Author: bringert $ --- > CVS $Revision: 1.5 $ +-- > CVS $Revision: 1.6 $ -- -- Approximates CFGs with finite state networks. ----------------------------------------------------------------------------- @@ -28,7 +28,7 @@ import GF.Speech.Relation import GF.Speech.TransformCFG cfgToFA :: Ident -- ^ Grammar name - -> Options -> CGrammar -> NFA String + -> Options -> CGrammar -> DFA String cfgToFA name opts = minimize . compileAutomaton start . makeSimpleRegular where start = getStartCat opts diff --git a/src/GF/Speech/FiniteState.hs b/src/GF/Speech/FiniteState.hs index 51cacb1e1..cfcc6e096 100644 --- a/src/GF/Speech/FiniteState.hs +++ b/src/GF/Speech/FiniteState.hs @@ -5,9 +5,9 @@ -- Stability : (stable) -- Portability : (portable) -- --- > CVS $Date: 2005/10/27 09:16:30 $ +-- > CVS $Date: 2005/11/10 16:43:44 $ -- > CVS $Author: bringert $ --- > CVS $Revision: 1.15 $ +-- > CVS $Revision: 1.16 $ -- -- A simple finite state network module. ----------------------------------------------------------------------------- @@ -19,6 +19,7 @@ module GF.Speech.FiniteState (FA, State, NFA, DFA, newState, newTransition, mapStates, mapTransitions, moveLabelsToNodes, minimize, + dfa2nfa, prFAGraphviz) where import Data.List @@ -36,7 +37,7 @@ data FA n a b = FA (Graph n a b) n [n] type NFA a = FA State () (Maybe a) -type DFA a = FA [State] () a +type DFA a = FA State () a startState :: FA n a b -> n @@ -72,8 +73,8 @@ mapStates f = onGraph (nmap f) mapTransitions :: (b -> c) -> FA n a b -> FA n a c mapTransitions f = onGraph (emap f) -minimize :: Ord a => NFA a -> NFA a -minimize = dfa2nfa . determinize . reverseNFA . dfa2nfa . determinize . reverseNFA +minimize :: Ord a => NFA a -> DFA a +minimize = determinize . reverseNFA . dfa2nfa . determinize . reverseNFA onGraph :: (Graph n a b -> Graph n c d) -> FA n a b -> FA n c d onGraph f (FA g s ss) = FA (f g) s ss @@ -114,11 +115,11 @@ alphabet = nub . catMaybes . map getLabel . edges determinize :: Ord a => NFA a -> DFA a determinize (FA g s f) = let (ns,es) = h [start] [] [] final = filter (not . null . (f `intersect`)) ns - in FA (Graph (freshDFANodes g) [(n,()) | n <- ns] es) start final + fa = FA (Graph undefined [(n,()) | n <- ns] es) start final + in numberStates fa where out = outgoing g start = closure out [s] isDFAFinal n = not (null (f `intersect` n)) - freshDFANodes (Graph ns _ _) = map (:[]) ns -- Get the new DFA states and edges produced by a set of DFA states. new ns = unzip [ (s, (n,s,c)) | n <- ns, (c,s) <- reachable out n] h currentStates oldStates oldEdges @@ -128,6 +129,14 @@ determinize (FA g s f) = let (ns,es) = h [start] [] [] allOldStates = currentStates ++ oldStates newStates' = nub newStates \\ allOldStates +numberStates :: (Ord x,Enum y) => FA x a b -> FA y a b +numberStates (FA g s fs) = FA (renameNodes newName rest g) s' fs' + where (ns,rest) = splitAt (length (nodes g)) $ [toEnum 0 .. ] + newNodes = zip (map fst (nodes g)) ns + newName n = lookup' n newNodes + s' = newName s + fs' = map newName fs + -- | Get all the nodes reachable from a set of nodes by only empty edges. closure :: Eq n => Outgoing n a (Maybe b) -> [n] -> [n] closure out = fix closure_ @@ -146,15 +155,7 @@ reverseNFA (FA g s fs) = FA g''' s' [s] g''' = newEdges [(s',f,Nothing) | f <- fs] g'' dfa2nfa :: DFA a -> NFA a -dfa2nfa (FA (Graph _ ns es) s fs) = FA (Graph c ns' es') s' fs' - where newNodes = zip (map fst ns) [0..] - newNode n = lookup' n newNodes - c = [length ns..] - ns' = [ (n,()) | (_,n) <- newNodes ] - es' = [ (newNode f, newNode t,Just l) | (f,t,l) <- es] - s' = newNode s - fs' = map newNode fs - +dfa2nfa = mapTransitions Just -- -- * Visualization diff --git a/src/GF/Speech/Graph.hs b/src/GF/Speech/Graph.hs index 64b73a70a..2f80ef0ca 100644 --- a/src/GF/Speech/Graph.hs +++ b/src/GF/Speech/Graph.hs @@ -5,9 +5,9 @@ -- Stability : (stable) -- Portability : (portable) -- --- > CVS $Date: 2005/10/26 17:13:13 $ +-- > CVS $Date: 2005/11/10 16:43:44 $ -- > CVS $Author: bringert $ --- > CVS $Revision: 1.1 $ +-- > CVS $Revision: 1.2 $ -- -- A simple graph module. ----------------------------------------------------------------------------- @@ -16,7 +16,7 @@ module GF.Speech.Graph ( Graph(..), Node, Edge, Incoming, Outgoing , nmap, emap, newNode, newEdge, newEdges , incoming, outgoing, getOutgoing , getFrom, getTo, getLabel - , reverseGraph + , reverseGraph, renameNodes ) where import GF.Data.Utilities @@ -41,9 +41,11 @@ nodes (Graph _ ns _) = ns edges :: Graph n a b -> [Edge n b] edges (Graph _ _ es) = es +-- | Map a function over the node label.s nmap :: (a -> c) -> Graph n a b -> Graph n c b nmap f (Graph c ns es) = Graph c [(n,f l) | (n,l) <- ns] es +-- | Map a function over the edge labels. emap :: (b -> c) -> Graph n a b -> Graph n a c emap f (Graph c ns es) = Graph c ns [(x,y,f l) | (x,y,l) <- es] @@ -86,3 +88,12 @@ getLabel (_,_,l) = l reverseGraph :: Graph n a b -> Graph n a b reverseGraph (Graph c ns es) = Graph c ns [ (t,f,l) | (f,t,l) <- es ] + +-- | Re-name the nodes in the graph. +renameNodes :: (n -> m) -- ^ renaming function + -> [m] -- ^ infinite supply of fresh node names, to + -- use when adding nodes in the future. + -> Graph n a b -> Graph m a b +renameNodes newName c (Graph _ ns es) = Graph c ns' es' + where ns' = [ (newName n,x) | (n,x) <- ns ] + es' = [ (newName f, newName t, l) | (f,t,l) <- es] diff --git a/src/GF/Speech/PrFA.hs b/src/GF/Speech/PrFA.hs index 28745066f..79a9356db 100644 --- a/src/GF/Speech/PrFA.hs +++ b/src/GF/Speech/PrFA.hs @@ -5,9 +5,9 @@ -- Stability : (stable) -- Portability : (portable) -- --- > CVS $Date: 2005/11/10 14:19:33 $ +-- > CVS $Date: 2005/11/10 16:43:44 $ -- > CVS $Author: bringert $ --- > CVS $Revision: 1.1 $ +-- > CVS $Revision: 1.2 $ -- -- This module prints finite automata and regular grammars -- for a context-free grammar. @@ -16,7 +16,7 @@ -- categories in the grammar ----------------------------------------------------------------------------- -module GF.Speech.PrFA (faGraphvizPrinter,regularPrinter) where +module GF.Speech.PrFA (faGraphvizPrinter,regularPrinter,faCPrinter) where import GF.Data.Utilities import GF.Conversion.Types @@ -37,7 +37,7 @@ import Data.Maybe (fromMaybe) faGraphvizPrinter :: Ident -- ^ Grammar name -> Options -> CGrammar -> String faGraphvizPrinter name opts cfg = - prFAGraphviz (mapStates (const "") $ mapTransitions (fromMaybe "") $ cfgToFA name opts cfg) + prFAGraphviz $ mapStates (const "") $ cfgToFA name opts cfg -- | Convert the grammar to a regular grammar and print it in BNF @@ -48,3 +48,10 @@ regularPrinter = prCFRules . makeSimpleRegular prCFRules g = unlines [ c ++ " ::= " ++ join " | " (map (showRhs . ruleRhs) rs) | (c,rs) <- g] join g = concat . intersperse g showRhs = unwords . map (symbol id show) + +faCPrinter :: Ident -- ^ Grammar name + -> Options -> CGrammar -> String +faCPrinter name opts cfg = fa2c $ cfgToFA name opts cfg + +fa2c :: DFA String -> String +fa2c fa = undefined \ No newline at end of file diff --git a/src/GF/Speech/PrSLF.hs b/src/GF/Speech/PrSLF.hs index 7a328dd1d..bd6eba5bb 100644 --- a/src/GF/Speech/PrSLF.hs +++ b/src/GF/Speech/PrSLF.hs @@ -5,9 +5,9 @@ -- Stability : (stable) -- Portability : (portable) -- --- > CVS $Date: 2005/11/10 14:19:33 $ +-- > CVS $Date: 2005/11/10 16:43:44 $ -- > CVS $Author: bringert $ --- > CVS $Revision: 1.11 $ +-- > CVS $Revision: 1.12 $ -- -- This module converts a CFG to an SLF finite-state network -- for use with the ATK recognizer. The SLF format is described @@ -48,12 +48,12 @@ data SLFEdge = SLFEdge { eId :: Int, eStart :: Int, eEnd :: Int } slfPrinter :: Ident -- ^ Grammar name -> Options -> CGrammar -> String -slfPrinter name opts cfg = prSLF (automatonToSLF $ moveLabelsToNodes $ cfgToFA name opts cfg) "" +slfPrinter name opts cfg = prSLF (automatonToSLF $ moveLabelsToNodes $ dfa2nfa $ cfgToFA name opts cfg) "" slfGraphvizPrinter :: Ident -- ^ Grammar name -> Options -> CGrammar -> String slfGraphvizPrinter name opts cfg = - prFAGraphviz (mapStates (fromMaybe "") $ mapTransitions (const "") $ moveLabelsToNodes $ cfgToFA name opts cfg) + prFAGraphviz $ mapStates (fromMaybe "") $ mapTransitions (const "") $ moveLabelsToNodes $ dfa2nfa $ cfgToFA name opts cfg automatonToSLF :: FA State (Maybe String) () -> SLF automatonToSLF fa = diff --git a/src/GF/UseGrammar/Custom.hs b/src/GF/UseGrammar/Custom.hs index 9a4ce997d..1db93bff3 100644 --- a/src/GF/UseGrammar/Custom.hs +++ b/src/GF/UseGrammar/Custom.hs @@ -5,9 +5,9 @@ -- Stability : (stable) -- Portability : (portable) -- --- > CVS $Date: 2005/11/10 14:19:33 $ +-- > CVS $Date: 2005/11/10 16:43:45 $ -- > CVS $Author: bringert $ --- > CVS $Revision: 1.83 $ +-- > CVS $Revision: 1.84 $ -- -- A database for customizable GF shell commands. -- @@ -59,7 +59,7 @@ import GF.Speech.PrGSL (gslPrinter) import GF.Speech.PrJSGF (jsgfPrinter) import GF.Speech.PrSRGS (srgsXmlPrinter) import GF.Speech.PrSLF (slfPrinter,slfGraphvizPrinter) -import GF.Speech.PrFA (faGraphvizPrinter,regularPrinter) +import GF.Speech.PrFA (faGraphvizPrinter,regularPrinter,faCPrinter) import GF.Data.Zipper @@ -261,6 +261,9 @@ customGrammarPrinter = ,(strCI "fa_graphviz", \s -> let opts = stateOptions s name = cncId s in faGraphvizPrinter name opts $ stateCFG s) + ,(strCI "fa_c", \s -> let opts = stateOptions s + name = cncId s + in faCPrinter name opts $ stateCFG s) ,(strCI "regular", regularPrinter . stateCFG) ,(strCI "plbnf", prLBNF True) ,(strCI "lbnf", prLBNF False)