summaryrefslogtreecommitdiff
path: root/src/GF/Speech/SLF.hs
diff options
context:
space:
mode:
authorkrasimir <krasimir@chalmers.se>2009-12-13 18:50:29 +0000
committerkrasimir <krasimir@chalmers.se>2009-12-13 18:50:29 +0000
commitf85232947e74ee7ef8c7b0ad2338212e7e68f1be (patch)
tree667b886a5e3a4b026a63d4e3597f32497d824761 /src/GF/Speech/SLF.hs
parentd88a865faff59c98fc91556ff8700b10ee5f2df8 (diff)
reorganize the directories under src, and rescue the JavaScript interpreter from deprecated
Diffstat (limited to 'src/GF/Speech/SLF.hs')
-rw-r--r--src/GF/Speech/SLF.hs178
1 files changed, 0 insertions, 178 deletions
diff --git a/src/GF/Speech/SLF.hs b/src/GF/Speech/SLF.hs
deleted file mode 100644
index 84633149b..000000000
--- a/src/GF/Speech/SLF.hs
+++ /dev/null
@@ -1,178 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module : GF.Speech.SLF
---
--- This module converts a CFG to an SLF finite-state network
--- for use with the ATK recognizer. The SLF format is described
--- in the HTK manual, and an example for use in ATK is shown
--- in the ATK manual.
---
------------------------------------------------------------------------------
-
-module GF.Speech.SLF (slfPrinter,slfGraphvizPrinter,
- slfSubPrinter,slfSubGraphvizPrinter) where
-
-import GF.Data.Utilities
-import GF.Speech.CFG
-import GF.Speech.FiniteState
-import GF.Speech.CFG
-import GF.Speech.CFGToFA
-import GF.Speech.PGFToCFG
-import qualified GF.Data.Graphviz as Dot
-import PGF
-import PGF.CId
-
-import Control.Monad
-import qualified Control.Monad.State as STM
-import Data.Char (toUpper)
-import Data.List
-import Data.Maybe
-
-data SLFs = SLFs [(String,SLF)] SLF
-
-data SLF = SLF { slfNodes :: [SLFNode], slfEdges :: [SLFEdge] }
-
-data SLFNode = SLFNode { nId :: Int, nWord :: SLFWord, nTag :: Maybe String }
- | SLFSubLat { nId :: Int, nLat :: String }
-
--- | An SLF word is a word, or the empty string.
-type SLFWord = Maybe String
-
-data SLFEdge = SLFEdge { eId :: Int, eStart :: Int, eEnd :: Int }
-
-type SLF_FA = FA State (Maybe CFSymbol) ()
-
-mkFAs :: PGF -> CId -> (SLF_FA, [(String,SLF_FA)])
-mkFAs pgf cnc = (slfStyleFA main, [(c,slfStyleFA n) | (c,n) <- subs])
- where MFA start subs = {- renameSubs $ -} cfgToMFA $ pgfToCFG pgf cnc
- main = let (fa,s,f) = newFA_ in newTransition s f (NonTerminal start) fa
-
-slfStyleFA :: Eq a => DFA a -> FA State (Maybe a) ()
-slfStyleFA = renameStates [0..] . removeTrivialEmptyNodes . oneFinalState Nothing ()
- . moveLabelsToNodes . dfa2nfa
-
--- | Give sequential names to subnetworks.
-renameSubs :: MFA -> MFA
-renameSubs (MFA start subs) = MFA (newName start) subs'
- where newNames = zip (map fst subs) ["sub"++show n | n <- [0..]]
- newName s = lookup' s newNames
- subs' = [(newName s,renameLabels n) | (s,n) <- subs]
- renameLabels = mapTransitions (mapSymbol newName id)
-
---
--- * SLF graphviz printing (without sub-networks)
---
-
-slfGraphvizPrinter :: PGF -> CId -> String
-slfGraphvizPrinter pgf cnc
- = prFAGraphviz $ gvFA $ slfStyleFA $ cfgToFA' $ pgfToCFG pgf cnc
- where
- gvFA = mapStates (fromMaybe "") . mapTransitions (const "")
-
---
--- * SLF graphviz printing (with sub-networks)
---
-
-slfSubGraphvizPrinter :: PGF -> CId -> String
-slfSubGraphvizPrinter pgf cnc = Dot.prGraphviz g
- where (main, subs) = mkFAs pgf cnc
- g = STM.evalState (liftM2 Dot.addSubGraphs ss m) [0..]
- ss = mapM (\ (c,f) -> gvSLFFA (Just c) f) subs
- m = gvSLFFA Nothing main
-
-gvSLFFA :: Maybe String -> SLF_FA -> STM.State [State] Dot.Graph
-gvSLFFA n fa =
- liftM (mkCluster n . faToGraphviz . mapStates (maybe "" mfaLabelToGv)
- . mapTransitions (const "")) (rename fa)
- where mfaLabelToGv = symbol ("#"++) id
- mkCluster Nothing = id
- mkCluster (Just x)
- = Dot.setName ("cluster_"++x) . Dot.setAttr "label" x
- rename fa = do
- names <- STM.get
- let fa' = renameStates names fa
- names' = unusedNames fa'
- STM.put names'
- return fa'
-
---
--- * SLF printing (without sub-networks)
---
-
-slfPrinter :: PGF -> CId -> String
-slfPrinter pgf cnc
- = prSLF $ automatonToSLF mkSLFNode $ slfStyleFA $ cfgToFA' $ pgfToCFG pgf cnc
-
---
--- * SLF printing (with sub-networks)
---
-
--- | Make a network with subnetworks in SLF
-slfSubPrinter :: PGF -> CId -> String
-slfSubPrinter pgf cnc = prSLFs slfs
- where
- (main,subs) = mkFAs pgf cnc
- slfs = SLFs [(c, faToSLF fa) | (c,fa) <- subs] (faToSLF main)
- faToSLF = automatonToSLF mfaNodeToSLFNode
-
-automatonToSLF :: (Int -> a -> SLFNode) -> FA State a () -> SLF
-automatonToSLF mkNode fa = SLF { slfNodes = ns, slfEdges = es }
- where ns = map (uncurry mkNode) (states fa)
- es = zipWith (\i (f,t,()) -> mkSLFEdge i (f,t)) [0..] (transitions fa)
-
-mfaNodeToSLFNode :: Int -> Maybe CFSymbol -> SLFNode
-mfaNodeToSLFNode i l = case l of
- Nothing -> mkSLFNode i Nothing
- Just (Terminal x) -> mkSLFNode i (Just x)
- Just (NonTerminal s) -> mkSLFSubLat i s
-
-mkSLFNode :: Int -> Maybe String -> SLFNode
-mkSLFNode i Nothing = SLFNode { nId = i, nWord = Nothing, nTag = Nothing }
-mkSLFNode i (Just w)
- | isNonWord w = SLFNode { nId = i,
- nWord = Nothing,
- nTag = Just w }
- | otherwise = SLFNode { nId = i,
- nWord = Just (map toUpper w),
- nTag = Just w }
-
-mkSLFSubLat :: Int -> String -> SLFNode
-mkSLFSubLat i sub = SLFSubLat { nId = i, nLat = sub }
-
-mkSLFEdge :: Int -> (Int,Int) -> SLFEdge
-mkSLFEdge i (f,t) = SLFEdge { eId = i, eStart = f, eEnd = t }
-
-prSLFs :: SLFs -> String
-prSLFs (SLFs subs main) = unlinesS (map prSub subs ++ [prOneSLF main]) ""
- where prSub (n,s) = showString "SUBLAT=" . shows n
- . nl . prOneSLF s . showString "." . nl
-
-prSLF :: SLF -> String
-prSLF slf = prOneSLF slf ""
-
-prOneSLF :: SLF -> ShowS
-prOneSLF (SLF { slfNodes = ns, slfEdges = es})
- = header . unlinesS (map prNode ns) . nl . unlinesS (map prEdge es) . nl
- where
- header = prFields [("N",show (length ns)),("L", show (length es))] . nl
- prNode (SLFNode { nId = i, nWord = w, nTag = t })
- = prFields $ [("I",show i),("W",showWord w)]
- ++ maybe [] (\t -> [("s",t)]) t
- prNode (SLFSubLat { nId = i, nLat = l })
- = prFields [("I",show i),("L",show l)]
- prEdge e = prFields [("J",show (eId e)),("S",show (eStart e)),("E",show (eEnd e))]
-
--- | Check if a word should not correspond to a word in the SLF file.
-isNonWord :: String -> Bool
-isNonWord = any isPunct
-
-isPunct :: Char -> Bool
-isPunct c = c `elem` "-_.;.,?!()[]{}"
-
-showWord :: SLFWord -> String
-showWord Nothing = "!NULL"
-showWord (Just w) | null w = "!NULL"
- | otherwise = w
-
-prFields :: [(String,String)] -> ShowS
-prFields fs = unwordsS [ showString l . showChar '=' . showString v | (l,v) <- fs ]