msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

Use cat and language in ATK si. Support language switching with ATK.

Browse Source
This commit is contained in:
bringert
2006-01-17 02:13:57 +00:00
parent 4b6e4fe707
commit 6370fbfec5
8 changed files with 99 additions and 81 deletions
Download Patch File Download Diff File Expand all files Collapse all files

13
src/GF/API.hs
View File

@@ -75,6 +75,7 @@ import GF.Infra.UseIO
import GF.Data.Zipper
import Data.List (nub)
import Data.Maybe (fromMaybe)
import Control.Monad (liftM)
import System (system)
@@ -208,13 +209,15 @@ speechGenerate opts str = do
--- system ("echo" +++ "\"" ++ str ++ "\" | festival --tts" ++ lan)
return ()
-- FIXME: look at flags
speechInput :: Options -> StateGrammar -> IO String
speechInput opt s = recognizeSpeech name opts cfg
speechInput :: Options -> StateGrammar -> IO [String]
speechInput opt s = recognizeSpeech name language cfg cat number
where
opts = stateOptions s
opts = addOptions opt (stateOptions s)
name = cncId s
cfg = stateCFG s
cfg = stateCFG s -- FIXME: use lang flag to select grammar
language = fromMaybe "en_UK" (getOptVal opts speechLanguage)
cat = fromMaybe "S" (getOptVal opts gStartCat)
number = optIntOrN opts flagNumber 1
optLinearizeTreeVal :: Options -> GFGrammar -> Tree -> String
optLinearizeTreeVal opts gr = err id id . optLinearizeTree opts gr

2
src/GF/Shell.hs
View File

@@ -348,7 +348,7 @@ execC co@(comm, opts0) sa@(sh@(st,(h,_,_,_)),a) = checkOptions st co >> case com
CWriteFile file -> justOutputArg opts (writeFile file) sa
CAppendFile file -> justOutputArg opts (appendFile file) sa
CSpeakAloud -> justOutputArg opts (speechGenerate opts) sa
CSpeechInput -> returnArgIO (speechInput opts gro >>= return . AString) sa
CSpeechInput -> returnArgIO (speechInput opts gro >>= return . AString . unlines) sa
CSystemCommand s -> case a of
AUnit -> justOutput opts (system s >> return ()) sa
_ -> systemArg opts a s sa

15
src/GF/Speech/CFGToFiniteState.hs
View File

@@ -27,7 +27,6 @@ import GF.Formalism.CFG
import GF.Formalism.Utilities (Symbol(..), mapSymbol, filterCats, symbol, NameProfile(..))
import GF.Conversion.Types
import GF.Infra.Ident (Ident)
import GF.Infra.Option (Options)
import GF.Speech.FiniteState
import GF.Speech.Graph
@@ -57,9 +56,8 @@ data MFA a = MFA (DFA (MFALabel a)) [(String,DFA (MFALabel a))]
cfgToFA :: Options -> CGrammar -> DFA String
cfgToFA opts = minimize . compileAutomaton start . makeSimpleRegular
where start = getStartCat opts
cfgToFA :: String -> CGrammar -> DFA String
cfgToFA start = minimize . compileAutomaton start . makeSimpleRegular
makeSimpleRegular :: CGrammar -> CFRules
makeSimpleRegular = makeRegular . removeIdenticalRules . removeEmptyCats . cfgToCFRules
@@ -155,13 +153,12 @@ make_fa c@(g,ns) q0 alpha q1 fa =
-- * Compile a strongly regular grammar to a DFA with sub-automata
--
cfgToMFA :: Options -> CGrammar -> MFA String
cfgToMFA opts g = buildMFA start g
where start = getStartCat opts
cfgToMFA :: String -> CGrammar -> MFA String
cfgToMFA start g = buildMFA start g
-- | Build a DFA by building and expanding an MFA
cfgToFA' :: Options -> CGrammar -> DFA String
cfgToFA' opts g = mfaToDFA $ cfgToMFA opts g
cfgToFA' :: String -> CGrammar -> DFA String
cfgToFA' start g = mfaToDFA $ cfgToMFA start g
buildMFA :: Cat_ -- ^ Start category
-> CGrammar -> MFA String

11
src/GF/Speech/PrFA.hs
View File

@@ -23,7 +23,6 @@ import GF.Conversion.Types
import GF.Formalism.CFG
import GF.Formalism.Utilities (Symbol(..),symbol)
import GF.Infra.Ident
import GF.Infra.Option
import GF.Infra.Print
import GF.Speech.CFGToFiniteState
import GF.Speech.FiniteState
@@ -37,10 +36,10 @@ import Data.Maybe (fromMaybe)
faGraphvizPrinter :: Ident -- ^ Grammar name
-> Options -> CGrammar -> String
faGraphvizPrinter name opts cfg =
-> String -> CGrammar -> String
faGraphvizPrinter name start cfg =
prFAGraphviz $ mapStates (const "") fa
where fa = cfgToFA opts cfg
where fa = cfgToFA start cfg
-- | Convert the grammar to a regular grammar and print it in BNF
@@ -53,8 +52,8 @@ regularPrinter = prCFRules . makeSimpleRegular
showRhs = unwords . map (symbol id show)
faCPrinter :: Ident -- ^ Grammar name
-> Options -> CGrammar -> String
faCPrinter name opts cfg = fa2c $ cfgToFA opts cfg
-> String -> CGrammar -> String
faCPrinter name start cfg = fa2c $ cfgToFA start cfg
fa2c :: DFA String -> String
fa2c fa = undefined

31
src/GF/Speech/PrSLF.hs
View File

@@ -26,7 +26,6 @@ import GF.Conversion.Types
import GF.Formalism.CFG
import GF.Formalism.Utilities (Symbol(..),symbol)
import GF.Infra.Ident
import GF.Infra.Option
import GF.Infra.Print
import GF.Speech.CFGToFiniteState
import GF.Speech.FiniteState
@@ -54,9 +53,9 @@ data SLFEdge = SLFEdge { eId :: Int, eStart :: Int, eEnd :: Int }
type SLF_FA = FA State (Maybe (MFALabel String)) ()
mkFAs :: Options -> CGrammar -> (SLF_FA, [(String,SLF_FA)])
mkFAs opts cfg = (slfStyleFA main, [(c,slfStyleFA n) | (c,n) <- subs])
where MFA main subs = {- renameSubs $ -} cfgToMFA opts cfg
mkFAs :: String -> CGrammar -> (SLF_FA, [(String,SLF_FA)])
mkFAs start cfg = (slfStyleFA main, [(c,slfStyleFA n) | (c,n) <- subs])
where MFA main subs = {- renameSubs $ -} cfgToMFA start cfg
slfStyleFA :: Eq a => DFA a -> FA State (Maybe a) ()
slfStyleFA = renameStates [0..] . removeTrivialEmptyNodes . oneFinalState Nothing ()
@@ -76,9 +75,9 @@ renameSubs (MFA main subs) = MFA (renameLabels main) subs'
-- * SLF graphviz printing (without sub-networks)
--
slfGraphvizPrinter :: Ident -> Options -> CGrammar -> String
slfGraphvizPrinter name opts cfg
= prFAGraphviz $ gvFA $ slfStyleFA $ cfgToFA' opts cfg
slfGraphvizPrinter :: Ident -> String -> CGrammar -> String
slfGraphvizPrinter name start cfg
= prFAGraphviz $ gvFA $ slfStyleFA $ cfgToFA' start cfg
where
gvFA = mapStates (fromMaybe "") . mapTransitions (const "")
@@ -87,9 +86,9 @@ slfGraphvizPrinter name opts cfg
--
slfSubGraphvizPrinter :: Ident -- ^ Grammar name
-> Options -> CGrammar -> String
slfSubGraphvizPrinter name opts cfg = Dot.prGraphviz g
where (main, subs) = mkFAs opts cfg
-> String -> CGrammar -> String
slfSubGraphvizPrinter name start cfg = Dot.prGraphviz g
where (main, subs) = mkFAs start cfg
g = STM.evalState (liftM2 Dot.addSubGraphs ss m) [0..]
ss = mapM (\ (c,f) -> gvSLFFA (Just c) f) subs
m = gvSLFFA Nothing main
@@ -114,9 +113,9 @@ gvSLFFA n fa =
-- * SLF printing (without sub-networks)
--
slfPrinter :: Ident -> Options -> CGrammar -> String
slfPrinter name opts cfg
= prSLF (automatonToSLF mkSLFNode $ slfStyleFA $ cfgToFA' opts cfg) ""
slfPrinter :: Ident -> String -> CGrammar -> String
slfPrinter name start cfg
= prSLF (automatonToSLF mkSLFNode $ slfStyleFA $ cfgToFA' start cfg) ""
--
-- * SLF printing (with sub-networks)
@@ -124,10 +123,10 @@ slfPrinter name opts cfg
-- | Make a network with subnetworks in SLF
slfSubPrinter :: Ident -- ^ Grammar name
-> Options -> CGrammar -> String
slfSubPrinter name opts cfg = prSLFs slfs ""
-> String -> CGrammar -> String
slfSubPrinter name start cfg = prSLFs slfs ""
where
(main,subs) = mkFAs opts cfg
(main,subs) = mkFAs start cfg
slfs = SLFs [(c, faToSLF fa) | (c,fa) <- subs] (faToSLF main)
faToSLF = automatonToSLF mfaNodeToSLFNode

77
src/GF/System/ATKSpeechInput.hs
View File

@@ -59,64 +59,71 @@ getLanguage l =
("HPARM:CMNDEFAULT", res ++ "/UK_SI_ZMFCC/cepmean")]
}
"sv_SE" -> do
let res = "/home/bjorn/projects/atkswe/stoneage-swe"
let res = "/home/bjorn/projects/atkswe/numerals-swe/final"
return $ ATKLang {
hmmlist = res ++ "/triphones1",
mmf0 = res ++ "/hmm12/macros",
mmf1 = res ++ "/hmm12/hmmdefs",
dict = res ++ "/dict",
hmmlist = res ++ "/hmm_tri/hmmlist",
mmf0 = res ++ "/hmm_tri/macros",
mmf1 = res ++ "/hmm_tri/hmmdefs",
dict = res ++ "/NumeralsSwe.dct",
opts = [("TARGETKIND", "MFCC_0_D_A")]
}
_ -> fail $ "ATKSpeechInput: language " ++ l ++ " not supported"
-- | List of the languages for which we have already loaded the HMM
-- | Current language for which we have loaded the HMM
-- and dictionary.
{-# NOINLINE languages #-}
languages :: IORef [String]
languages = unsafePerformIO $ newIORef []
{-# NOINLINE currentLang #-}
currentLang :: IORef (Maybe String)
currentLang = unsafePerformIO $ newIORef Nothing
-- | Initializes the ATK, loading the given language.
-- ATK must not be initialized when calling this function.
loadLang :: String -> IO ()
loadLang lang =
do
l <- getLanguage lang
config <- getEnv_ "GF_ATK_CFG" gf_atk_cfg_error
hPutStrLn stderr $ "Initializing ATK..."
initialize (Just config) (opts l)
let hmmName = "hmm_" ++ lang
dictName = "dict_" ++ lang
hPutStrLn stderr $ "Initializing ATK (" ++ lang ++ ")..."
loadHMMSet hmmName (hmmlist l) (mmf0 l) (mmf1 l)
loadDict dictName (dict l)
writeIORef currentLang (Just lang)
initATK :: String -> IO ()
initATK language =
initATK lang =
do
l <- getLanguage language
ls <- readIORef languages
when (null ls) $ do
config <- getEnv_ "GF_ATK_CFG" gf_atk_cfg_error
hPutStrLn stderr $ "Initializing ATK..."
-- FIXME: different recognizers need different global options
initialize (Just config) (opts l)
when (language `notElem` ls) $
do
let hmmName = "hmm_" ++ language
dictName = "dict_" ++ language
hPutStrLn stderr $ "Initializing ATK (" ++ language ++ ")..."
loadHMMSet hmmName (hmmlist l) (mmf0 l) (mmf1 l)
loadDict dictName (dict l)
writeIORef languages (language:ls)
ml <- readIORef currentLang
case ml of
Nothing -> loadLang lang
Just l | l == lang -> return ()
| otherwise -> do
deinitialize
loadLang lang
recognizeSpeech :: Ident -- ^ Grammar name
-> Options -> CGrammar -> IO String
recognizeSpeech name opts cfg =
-> String -- ^ Language, e.g. en_UK
-> CGrammar -- ^ Context-free grammar for input
-> String -- ^ Start category name
-> Int -- ^ Number of utterances
-> IO [String]
recognizeSpeech name language cfg start number =
do
-- Options
let language = fromMaybe "en_UK" (getOptVal opts speechLanguage)
cat = fromMaybe "S" (getOptVal opts gStartCat) ++ "{}.s"
number = optIntOrN opts flagNumber 1
-- FIXME: use values of cat and number flags
let slf = slfPrinter name opts cfg
-- FIXME: use cat
let slf = slfPrinter name start cfg
n = prIdent name
hmmName = "hmm_" ++ language
dictName = "dict_" ++ language
slfName = "gram_" ++ n
recName = "rec_" ++ language ++ "_" ++ n
print opts
writeFile "debug.net" slf
initATK language
hPutStrLn stderr "Loading grammar..."
loadGrammarString slfName slf
createRecognizer recName hmmName dictName slfName
hPutStrLn stderr "Listening..."
s <- recognize recName
s <- replicateM number (recognize recName)
return s

9
src/GF/System/NoSpeechInput.hs
View File

@@ -18,6 +18,11 @@ import GF.Infra.Ident (Ident)
import GF.Infra.Option (Options)
import GF.Conversion.Types (CGrammar)
recognizeSpeech :: Ident -- ^ Grammar name
-> Options -> CGrammar -> IO String
recognizeSpeech _ _ _ = fail "No speech input available"
-> String -- ^ Language, e.g. en_UK
-> CGrammar -- ^ Context-free grammar for input
-> String -- ^ Start category name
-> Int -- ^ Number of utterances
-> IO [String]
recognizeSpeech _ _ _ _ _ = fail "No speech input available"

22
src/GF/UseGrammar/Custom.hs
View File

@@ -101,6 +101,7 @@ import GF.Infra.UseIO
import Control.Monad
import Data.Char
import Data.Maybe (fromMaybe)
-- character codings
import GF.Text.Unicode
@@ -254,23 +255,29 @@ customGrammarPrinter =
probs = stateProbs s
in srgsXmlPrinter name opts (Just probs) $ stateCFG s)
,(strCI "slf", \s -> let opts = stateOptions s
start = getStartCat opts
name = cncId s
in slfPrinter name opts $ stateCFG s)
in slfPrinter name start $ stateCFG s)
,(strCI "slf_graphviz", \s -> let opts = stateOptions s
start = getStartCat opts
name = cncId s
in slfGraphvizPrinter name opts $ stateCFG s)
in slfGraphvizPrinter name start $ stateCFG s)
,(strCI "slf_sub", \s -> let opts = stateOptions s
start = getStartCat opts
name = cncId s
in slfSubPrinter name opts $ stateCFG s)
in slfSubPrinter name start $ stateCFG s)
,(strCI "slf_sub_graphviz", \s -> let opts = stateOptions s
start = getStartCat opts
name = cncId s
in slfSubGraphvizPrinter name opts $ stateCFG s)
in slfSubGraphvizPrinter name start $ stateCFG s)
,(strCI "fa_graphviz", \s -> let opts = stateOptions s
start = getStartCat opts
name = cncId s
in faGraphvizPrinter name opts $ stateCFG s)
in faGraphvizPrinter name start $ stateCFG s)
,(strCI "fa_c", \s -> let opts = stateOptions s
start = getStartCat opts
name = cncId s
in faCPrinter name opts $ stateCFG s)
in faCPrinter name start $ stateCFG s)
,(strCI "regular", regularPrinter . stateCFG)
,(strCI "plbnf", prLBNF True)
,(strCI "lbnf", prLBNF False)
@@ -321,7 +328,8 @@ customGrammarPrinter =
-- ,(strCI "cfg-old", PrtOld.prt . CnvOld.cfg . statePInfoOld)
]
where stateGrammarLangOpts s = (stateOptions s, stateGrammarLang s)
getStartCat :: Options -> String
getStartCat opts = fromMaybe "S" (getOptVal opts gStartCat) ++ "{}.s"
customMultiGrammarPrinter =
customData "Printers for multiple grammars, selected by option -printer=x" $