removed src for 2.9

1 files changed, 0 insertions, 329 deletions

diff --git a/src/GF/Speech/FiniteState.hs b/src/GF/Speech/FiniteState.hs
deleted file mode 100644
index 35274e3c4..000000000
--- a/src/GF/Speech/FiniteState.hs
+++ /dev/null
@@ -1,329 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module      : FiniteState
--- Maintainer  : BB
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/11/10 16:43:44 $ 
--- > CVS $Author: bringert $
--- > CVS $Revision: 1.16 $
---
--- A simple finite state network module.
------------------------------------------------------------------------------
-module GF.Speech.FiniteState (FA(..), State, NFA, DFA,
-			      startState, finalStates,
-			      states, transitions,
-                              isInternal,
-			      newFA, newFA_,
-			      addFinalState,
-			      newState, newStates,
-                              newTransition, newTransitions,
-                              insertTransitionWith, insertTransitionsWith,
-			      mapStates, mapTransitions,
-                              modifyTransitions,
-                              nonLoopTransitionsTo, nonLoopTransitionsFrom, 
-                              loops,
-                              removeState,
-                              oneFinalState,
-                              insertNFA,
-                              onGraph,
-			      moveLabelsToNodes, removeTrivialEmptyNodes,
-                              minimize,
-                              dfa2nfa,
-                              unusedNames, renameStates,
-			      prFAGraphviz, faToGraphviz) where
-
-import Data.List
-import Data.Maybe 
-import Data.Map (Map)
-import qualified Data.Map as Map
-import Data.Set (Set)
-import qualified Data.Set as Set
-
-import GF.Data.Utilities
-import GF.Speech.Graph
-import qualified GF.Visualization.Graphviz as Dot
-
-type State = Int
-
--- | Type parameters: node id type, state label type, edge label type
---   Data constructor arguments: nodes and edges, start state, final states
-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
-
-
-startState :: FA n a b -> n
-startState (FA _ s _) = s
-
-finalStates :: FA n a b -> [n]
-finalStates (FA _ _ ss) = ss
-
-states :: FA n a b -> [(n,a)]
-states (FA g _ _) = nodes g
-
-transitions :: FA n a b -> [(n,n,b)]
-transitions (FA g _ _) = edges g
-
-newFA :: Enum n => a -- ^ Start node label
-      -> FA n a b
-newFA l = FA g s []
-    where (g,s) = newNode l (newGraph [toEnum 0..])
-
--- | Create a new finite automaton with an initial and a final state.
-newFA_ :: Enum n => (FA n () b, n, n)
-newFA_ = (fa'', s, f)
-    where fa = newFA ()
-          s = startState fa
-          (fa',f) = newState () fa
-          fa'' = addFinalState f fa'
-
-addFinalState :: n -> FA n a b -> FA n a b
-addFinalState f (FA g s ss) = FA g s (f:ss)
-
-newState :: a -> FA n a b -> (FA n a b, n)
-newState x (FA g s ss) = (FA g' s ss, n)
-    where (g',n) = newNode x g
-
-newStates :: [a] -> FA n a b -> (FA n a b, [(n,a)])
-newStates xs (FA g s ss) = (FA g' s ss, ns)
-    where (g',ns) = newNodes xs g
-
-newTransition :: n -> n -> b -> FA n a b -> FA n a b
-newTransition f t l = onGraph (newEdge (f,t,l))
-
-newTransitions :: [(n, n, b)] -> FA n a b -> FA n a b
-newTransitions es = onGraph (newEdges es)
-
-insertTransitionWith :: Eq n => 
-                        (b -> b -> b) -> (n, n, b) -> FA n a b -> FA n a b
-insertTransitionWith f t = onGraph (insertEdgeWith f t)
-
-insertTransitionsWith :: Eq n => 
-                         (b -> b -> b) -> [(n, n, b)] -> FA n a b -> FA n a b
-insertTransitionsWith f ts fa = 
-    foldl' (flip (insertTransitionWith f)) fa ts
-
-mapStates :: (a -> c) -> FA n a b -> FA n c b
-mapStates f = onGraph (nmap f)
-
-mapTransitions :: (b -> c) -> FA n a b -> FA n a c
-mapTransitions f = onGraph (emap f)
-
-modifyTransitions :: ([(n,n,b)] -> [(n,n,b)]) -> FA n a b -> FA n a b
-modifyTransitions f = onGraph (\ (Graph r ns es) -> Graph r ns (f es))
-
-removeState :: Ord n => n -> FA n a b -> FA n a b
-removeState n = onGraph (removeNode n)
-
-minimize :: Ord a => NFA a -> DFA a
-minimize = determinize . reverseNFA . dfa2nfa . determinize . reverseNFA
-
-unusedNames :: FA n a b -> [n]
-unusedNames (FA (Graph names _ _) _ _) = names
-
--- | Gets all incoming transitions to a given state, excluding
--- transtions from the state itself.
-nonLoopTransitionsTo :: Eq n => n -> FA n a b -> [(n,b)]
-nonLoopTransitionsTo s fa = 
-    [(f,l) | (f,t,l) <- transitions fa, t == s && f /= s]
-
-nonLoopTransitionsFrom :: Eq n => n -> FA n a b -> [(n,b)]
-nonLoopTransitionsFrom s fa = 
-    [(t,l) | (f,t,l) <- transitions fa, f == s && t /= s]
-
-loops :: Eq n => n -> FA n a b -> [b]
-loops s fa = [l | (f,t,l) <- transitions fa, f == s && t == s]
-
--- | Give new names to all nodes.
-renameStates :: Ord x => [y] -- ^ Infinite supply of new names
-             -> FA x a b
-             -> FA y a b
-renameStates supply (FA g s fs) = FA (renameNodes newName rest g) s' fs'
-    where (ns,rest) = splitAt (length (nodes g)) supply
-          newNodes = Map.fromList (zip (map fst (nodes g)) ns)
-	  newName n = Map.findWithDefault (error "FiniteState.newName") n newNodes
-          s' = newName s
-          fs' = map newName fs
-
--- | Insert an NFA into another
-insertNFA :: NFA a -- ^ NFA to insert into
-          -> (State, State) -- ^ States to insert between
-          -> NFA a -- ^ NFA to insert.
-          -> NFA a
-insertNFA (FA g1 s1 fs1) (f,t) (FA g2 s2 fs2) 
-    = FA (newEdges es g') s1 fs1
-    where 
-    es = (f,ren s2,Nothing):[(ren f2,t,Nothing) | f2 <- fs2]
-    (g',ren) = mergeGraphs g1 g2
-
-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
-
-
--- | Make the finite automaton have a single final state
---   by adding a new final state and adding an edge
---   from the old final states to the new state.
-oneFinalState :: a        -- ^ Label to give the new node
-              -> b        -- ^ Label to give the new edges
-              -> FA n a b -- ^ The old network
-              -> FA n a b -- ^ The new network
-oneFinalState nl el fa =
-    let (FA g s fs,nf) = newState nl fa
-        es = [ (f,nf,el) | f <- fs ]
-     in FA (newEdges es g) s [nf]
-
--- | Transform a standard finite automaton with labelled edges
---   to one where the labels are on the nodes instead. This can add
---   up to one extra node per edge.
-moveLabelsToNodes :: (Ord n,Eq a) => FA n () (Maybe a) -> FA n (Maybe a) ()
-moveLabelsToNodes = onGraph f
-  where f g@(Graph c _ _) = Graph c' ns (concat ess)
-	    where is = [ ((n,l),inc) | (n, (l,inc,_)) <- Map.toList (nodeInfo g)]
-		  (c',is') = mapAccumL fixIncoming c is
-		  (ns,ess) = unzip (concat is')
-
-
--- | Remove empty nodes which are not start or final, and have
---   exactly one outgoing edge or exactly one incoming edge.
-removeTrivialEmptyNodes :: (Eq a, Ord n) => FA n (Maybe a) () -> FA n (Maybe a) ()
-removeTrivialEmptyNodes = pruneUnusable . skipSimpleEmptyNodes
-
--- | Move edges to empty nodes to point to the next node(s).
---   This is not done if the pointed-to node is a final node.
-skipSimpleEmptyNodes :: (Eq a, Ord n) => FA n (Maybe a) () -> FA n (Maybe a) ()
-skipSimpleEmptyNodes fa = onGraph og fa
-  where 
-  og g@(Graph c ns es) = if es' == es then g else og (Graph c ns es')
-    where
-    es' = concatMap changeEdge es
-    info = nodeInfo g
-    changeEdge e@(f,t,()) 
-      | isNothing (getNodeLabel info t)
-       -- && (i * o <= i + o)
-        && not (isFinal fa t)
-          = [ (f,t',()) | (_,t',()) <- getOutgoing info t]
-      | otherwise = [e]
---     where i = inDegree info t
---           o = outDegree info t
-
-isInternal :: Eq n => FA n a b -> n -> Bool
-isInternal (FA _ start final) n = n /= start && n `notElem` final
-
-isFinal :: Eq n => FA n a b -> n -> Bool
-isFinal (FA _ _ final) n = n `elem` final
-
--- | Remove all internal nodes with no incoming edges
---   or no outgoing edges.
-pruneUnusable :: Ord n => FA n (Maybe a) () -> FA n (Maybe a) ()
-pruneUnusable fa = onGraph f fa
- where
- f g = if Set.null rns then g else f (removeNodes rns g)
-  where info = nodeInfo g
-        rns = Set.fromList [ n | (n,_) <- nodes g, 
-                             isInternal fa n,
-                             inDegree info n == 0 
-                             || outDegree info n == 0]
-
-fixIncoming :: (Ord n, Eq a) => [n] 
-            -> (Node n (),[Edge n (Maybe a)]) -- ^ A node and its incoming edges
-            -> ([n],[(Node n (Maybe a),[Edge n ()])]) -- ^ Replacement nodes with their
-                                                      -- incoming edges.
-fixIncoming cs c@((n,()),es) = (cs'', ((n,Nothing),es'):newContexts)
-  where ls = nub $ map edgeLabel es
-	(cs',cs'') = splitAt (length ls) cs
-	newNodes = zip cs' ls
-	es' = [ (x,n,()) | x <- map fst newNodes ]
-	-- separate cyclic and non-cyclic edges
-	(cyc,ncyc) = partition (\ (f,_,_) -> f == n) es
-	          -- keep all incoming non-cyclic edges with the right label
-	to (x,l) = [ (f,x,()) | (f,_,l') <- ncyc, l == l']
-	          -- for each cyclic edge with the right label, 
-	          -- add an edge from each of the new nodes (including this one)
-		    ++ [ (y,x,()) | (f,_,l') <- cyc, l == l', (y,_) <- newNodes]
-	newContexts = [ (v, to v) | v <- newNodes ]
-
-alphabet :: Eq b => Graph n a (Maybe b) -> [b]
-alphabet = nub . catMaybes . map edgeLabel . edges
-
-determinize :: Ord a => NFA a -> DFA a
-determinize (FA g s f) = let (ns,es) = h (Set.singleton start) Set.empty Set.empty
-                             (ns',es') = (Set.toList ns, Set.toList es)
-                             final = filter isDFAFinal ns'
-                             fa = FA (Graph undefined [(n,()) | n <- ns'] es') start final
- 		          in renameStates [0..] fa
-  where info = nodeInfo g
---        reach = nodesReachable out
-	start = closure info $ Set.singleton s
-        isDFAFinal n = not (Set.null (Set.fromList f `Set.intersection` n))
-	h currentStates oldStates es
-	    | Set.null currentStates = (oldStates,es)
-	    | otherwise = ((h $! uniqueNewStates) $! allOldStates) $! es'
-	    where 
-	    allOldStates = oldStates `Set.union` currentStates
-            (newStates,es') = new (Set.toList currentStates) Set.empty es
-	    uniqueNewStates = newStates Set.\\ allOldStates
-        -- Get the sets of states reachable from the given states 
-        -- by consuming one symbol, and the associated edges.
-        new [] rs es = (rs,es)
-        new (n:ns) rs es = new ns rs' es'
-          where cs = reachable info n --reachable reach n
-                rs' = rs `Set.union` Set.fromList (map snd cs)
-                es' = es `Set.union` Set.fromList [(n,s,c) | (c,s) <- cs]
-
-
--- | Get all the nodes reachable from a list of nodes by only empty edges.
-closure :: Ord n => NodeInfo n a (Maybe b) -> Set n -> Set n
-closure info x = closure_ x x
-  where closure_ acc check | Set.null check = acc
-                           | otherwise = closure_ acc' check'
-            where
-            reach = Set.fromList [y | x <- Set.toList check, 
-                                      (_,y,Nothing) <- getOutgoing info x]
-            acc' = acc `Set.union` reach
-            check' = reach Set.\\ acc
-
--- | Get a map of labels to sets of all nodes reachable
---   from a the set of nodes by one edge with the given
---   label and then any number of empty edges.
-reachable :: (Ord n,Ord b) => NodeInfo n a (Maybe b) -> Set n -> [(b,Set n)]
-reachable info ns = Map.toList $ Map.map (closure info . Set.fromList) $ reachable1 info ns
-reachable1 info ns = Map.fromListWith (++) [(c, [y]) | n <- Set.toList ns, (_,y,Just c) <- getOutgoing info n]
-
-reverseNFA :: NFA a -> NFA a
-reverseNFA (FA g s fs) = FA g''' s' [s]
-    where g' = reverseGraph g
-	  (g'',s') = newNode () g'
-	  g''' = newEdges [(s',f,Nothing) | f <- fs] g''
-
-dfa2nfa :: DFA a -> NFA a
-dfa2nfa = mapTransitions Just
-
---
--- * Visualization
---
-
-prFAGraphviz :: (Eq n,Show n) => FA n String String -> String
-prFAGraphviz  = Dot.prGraphviz . faToGraphviz
-
-prFAGraphviz_ :: (Eq n,Show n,Show a, Show b) => FA n a b -> String
-prFAGraphviz_  = Dot.prGraphviz . faToGraphviz . mapStates show . mapTransitions show
-
-faToGraphviz :: (Eq n,Show n) => FA n String String -> Dot.Graph
-faToGraphviz (FA (Graph _ ns es) s f) 
-    = Dot.Graph Dot.Directed Nothing [] (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)]
-
---
--- * Utilities
---
-
-lookups :: Ord k => [k] -> Map k a -> [a]
-lookups xs m = mapMaybe (flip Map.lookup m) xs