GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-23 03:32:51 -06:00
Code Issues Packages Projects Releases Wiki 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 GF.Data.Zipper
import Data.List (nub) import Data.List (nub)
import Data.Maybe (fromMaybe)
import Control.Monad (liftM) import Control.Monad (liftM)
import System (system) import System (system)
@@ -208,13 +209,15 @@ speechGenerate opts str = do
--- system ("echo" +++ "\"" ++ str ++ "\" | festival --tts" ++ lan) --- system ("echo" +++ "\"" ++ str ++ "\" | festival --tts" ++ lan)
return () return ()
-- FIXME: look at flags speechInput :: Options -> StateGrammar -> IO [String]
speechInput :: Options -> StateGrammar -> IO String speechInput opt s = recognizeSpeech name language cfg cat number
speechInput opt s = recognizeSpeech name opts cfg
where where
opts = stateOptions s opts = addOptions opt (stateOptions s)
name = cncId 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 :: Options -> GFGrammar -> Tree -> String
optLinearizeTreeVal opts gr = err id id . optLinearizeTree opts gr 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 CWriteFile file -> justOutputArg opts (writeFile file) sa
CAppendFile file -> justOutputArg opts (appendFile file) sa CAppendFile file -> justOutputArg opts (appendFile file) sa
CSpeakAloud -> justOutputArg opts (speechGenerate opts) 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 CSystemCommand s -> case a of
AUnit -> justOutput opts (system s >> return ()) sa AUnit -> justOutput opts (system s >> return ()) sa
_ -> systemArg opts a s 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.Formalism.Utilities (Symbol(..), mapSymbol, filterCats, symbol, NameProfile(..))
import GF.Conversion.Types import GF.Conversion.Types
import GF.Infra.Ident (Ident) import GF.Infra.Ident (Ident)
import GF.Infra.Option (Options)
import GF.Speech.FiniteState import GF.Speech.FiniteState
import GF.Speech.Graph 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 :: String -> CGrammar -> DFA String
cfgToFA opts = minimize . compileAutomaton start . makeSimpleRegular cfgToFA start = minimize . compileAutomaton start . makeSimpleRegular
where start = getStartCat opts
makeSimpleRegular :: CGrammar -> CFRules makeSimpleRegular :: CGrammar -> CFRules
makeSimpleRegular = makeRegular . removeIdenticalRules . removeEmptyCats . cfgToCFRules 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 -- * Compile a strongly regular grammar to a DFA with sub-automata
-- --
cfgToMFA :: Options -> CGrammar -> MFA String cfgToMFA :: String -> CGrammar -> MFA String
cfgToMFA opts g = buildMFA start g cfgToMFA start g = buildMFA start g
where start = getStartCat opts
-- | Build a DFA by building and expanding an MFA -- | Build a DFA by building and expanding an MFA
cfgToFA' :: Options -> CGrammar -> DFA String cfgToFA' :: String -> CGrammar -> DFA String
cfgToFA' opts g = mfaToDFA $ cfgToMFA opts g cfgToFA' start g = mfaToDFA $ cfgToMFA start g
buildMFA :: Cat_ -- ^ Start category buildMFA :: Cat_ -- ^ Start category
-> CGrammar -> MFA String -> 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.CFG
import GF.Formalism.Utilities (Symbol(..),symbol) import GF.Formalism.Utilities (Symbol(..),symbol)
import GF.Infra.Ident import GF.Infra.Ident
import GF.Infra.Option
import GF.Infra.Print import GF.Infra.Print
import GF.Speech.CFGToFiniteState import GF.Speech.CFGToFiniteState
import GF.Speech.FiniteState import GF.Speech.FiniteState
@@ -37,10 +36,10 @@ import Data.Maybe (fromMaybe)
faGraphvizPrinter :: Ident -- ^ Grammar name faGraphvizPrinter :: Ident -- ^ Grammar name
-> Options -> CGrammar -> String -> String -> CGrammar -> String
faGraphvizPrinter name opts cfg = faGraphvizPrinter name start cfg =
prFAGraphviz $ mapStates (const "") fa 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 -- | 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) showRhs = unwords . map (symbol id show)
faCPrinter :: Ident -- ^ Grammar name faCPrinter :: Ident -- ^ Grammar name
-> Options -> CGrammar -> String -> String -> CGrammar -> String
faCPrinter name opts cfg = fa2c $ cfgToFA opts cfg faCPrinter name start cfg = fa2c $ cfgToFA start cfg
fa2c :: DFA String -> String fa2c :: DFA String -> String
fa2c fa = undefined 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.CFG
import GF.Formalism.Utilities (Symbol(..),symbol) import GF.Formalism.Utilities (Symbol(..),symbol)
import GF.Infra.Ident import GF.Infra.Ident
import GF.Infra.Option
import GF.Infra.Print import GF.Infra.Print
import GF.Speech.CFGToFiniteState import GF.Speech.CFGToFiniteState
import GF.Speech.FiniteState 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)) () type SLF_FA = FA State (Maybe (MFALabel String)) ()
mkFAs :: Options -> CGrammar -> (SLF_FA, [(String,SLF_FA)]) mkFAs :: String -> CGrammar -> (SLF_FA, [(String,SLF_FA)])
mkFAs opts cfg = (slfStyleFA main, [(c,slfStyleFA n) | (c,n) <- subs]) mkFAs start cfg = (slfStyleFA main, [(c,slfStyleFA n) | (c,n) <- subs])
where MFA main subs = {- renameSubs $ -} cfgToMFA opts cfg where MFA main subs = {- renameSubs $ -} cfgToMFA start cfg
slfStyleFA :: Eq a => DFA a -> FA State (Maybe a) () slfStyleFA :: Eq a => DFA a -> FA State (Maybe a) ()
slfStyleFA = renameStates [0..] . removeTrivialEmptyNodes . oneFinalState Nothing () slfStyleFA = renameStates [0..] . removeTrivialEmptyNodes . oneFinalState Nothing ()
@@ -76,9 +75,9 @@ renameSubs (MFA main subs) = MFA (renameLabels main) subs'
-- * SLF graphviz printing (without sub-networks) -- * SLF graphviz printing (without sub-networks)
-- --
slfGraphvizPrinter :: Ident -> Options -> CGrammar -> String slfGraphvizPrinter :: Ident -> String -> CGrammar -> String
slfGraphvizPrinter name opts cfg slfGraphvizPrinter name start cfg
= prFAGraphviz $ gvFA $ slfStyleFA $ cfgToFA' opts cfg = prFAGraphviz $ gvFA $ slfStyleFA $ cfgToFA' start cfg
where where
gvFA = mapStates (fromMaybe "") . mapTransitions (const "") gvFA = mapStates (fromMaybe "") . mapTransitions (const "")
@@ -87,9 +86,9 @@ slfGraphvizPrinter name opts cfg
-- --
slfSubGraphvizPrinter :: Ident -- ^ Grammar name slfSubGraphvizPrinter :: Ident -- ^ Grammar name
-> Options -> CGrammar -> String -> String -> CGrammar -> String
slfSubGraphvizPrinter name opts cfg = Dot.prGraphviz g slfSubGraphvizPrinter name start cfg = Dot.prGraphviz g
where (main, subs) = mkFAs opts cfg where (main, subs) = mkFAs start cfg
g = STM.evalState (liftM2 Dot.addSubGraphs ss m) [0..] g = STM.evalState (liftM2 Dot.addSubGraphs ss m) [0..]
ss = mapM (\ (c,f) -> gvSLFFA (Just c) f) subs ss = mapM (\ (c,f) -> gvSLFFA (Just c) f) subs
m = gvSLFFA Nothing main m = gvSLFFA Nothing main
@@ -114,9 +113,9 @@ gvSLFFA n fa =
-- * SLF printing (without sub-networks) -- * SLF printing (without sub-networks)
-- --
slfPrinter :: Ident -> Options -> CGrammar -> String slfPrinter :: Ident -> String -> CGrammar -> String
slfPrinter name opts cfg slfPrinter name start cfg
= prSLF (automatonToSLF mkSLFNode $ slfStyleFA $ cfgToFA' opts cfg) "" = prSLF (automatonToSLF mkSLFNode $ slfStyleFA $ cfgToFA' start cfg) ""
-- --
-- * SLF printing (with sub-networks) -- * SLF printing (with sub-networks)
@@ -124,10 +123,10 @@ slfPrinter name opts cfg
-- | Make a network with subnetworks in SLF -- | Make a network with subnetworks in SLF
slfSubPrinter :: Ident -- ^ Grammar name slfSubPrinter :: Ident -- ^ Grammar name
-> Options -> CGrammar -> String -> String -> CGrammar -> String
slfSubPrinter name opts cfg = prSLFs slfs "" slfSubPrinter name start cfg = prSLFs slfs ""
where where
(main,subs) = mkFAs opts cfg (main,subs) = mkFAs start cfg
slfs = SLFs [(c, faToSLF fa) | (c,fa) <- subs] (faToSLF main) slfs = SLFs [(c, faToSLF fa) | (c,fa) <- subs] (faToSLF main)
faToSLF = automatonToSLF mfaNodeToSLFNode faToSLF = automatonToSLF mfaNodeToSLFNode

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

@@ -59,64 +59,71 @@ getLanguage l =
("HPARM:CMNDEFAULT", res ++ "/UK_SI_ZMFCC/cepmean")] ("HPARM:CMNDEFAULT", res ++ "/UK_SI_ZMFCC/cepmean")]
} }
"sv_SE" -> do "sv_SE" -> do
let res = "/home/bjorn/projects/atkswe/stoneage-swe" let res = "/home/bjorn/projects/atkswe/numerals-swe/final"
return $ ATKLang { return $ ATKLang {
hmmlist = res ++ "/triphones1", hmmlist = res ++ "/hmm_tri/hmmlist",
mmf0 = res ++ "/hmm12/macros", mmf0 = res ++ "/hmm_tri/macros",
mmf1 = res ++ "/hmm12/hmmdefs", mmf1 = res ++ "/hmm_tri/hmmdefs",
dict = res ++ "/dict", dict = res ++ "/NumeralsSwe.dct",
opts = [("TARGETKIND", "MFCC_0_D_A")] opts = [("TARGETKIND", "MFCC_0_D_A")]
} }
_ -> fail $ "ATKSpeechInput: language " ++ l ++ " not supported" _ -> 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. -- and dictionary.
{-# NOINLINE languages #-} {-# NOINLINE currentLang #-}
languages :: IORef [String] currentLang :: IORef (Maybe String)
languages = unsafePerformIO $ newIORef [] 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 :: String -> IO ()
initATK language = initATK lang =
do do
l <- getLanguage language ml <- readIORef currentLang
ls <- readIORef languages case ml of
when (null ls) $ do Nothing -> loadLang lang
config <- getEnv_ "GF_ATK_CFG" gf_atk_cfg_error Just l | l == lang -> return ()
hPutStrLn stderr $ "Initializing ATK..." | otherwise -> do
-- FIXME: different recognizers need different global options deinitialize
initialize (Just config) (opts l) loadLang lang
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)
recognizeSpeech :: Ident -- ^ Grammar name recognizeSpeech :: Ident -- ^ Grammar name
-> Options -> CGrammar -> IO String -> String -- ^ Language, e.g. en_UK
recognizeSpeech name opts cfg = -> CGrammar -- ^ Context-free grammar for input
-> String -- ^ Start category name
-> Int -- ^ Number of utterances
-> IO [String]
recognizeSpeech name language cfg start number =
do do
-- Options -- FIXME: use cat
let language = fromMaybe "en_UK" (getOptVal opts speechLanguage) let slf = slfPrinter name start cfg
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
n = prIdent name n = prIdent name
hmmName = "hmm_" ++ language hmmName = "hmm_" ++ language
dictName = "dict_" ++ language dictName = "dict_" ++ language
slfName = "gram_" ++ n slfName = "gram_" ++ n
recName = "rec_" ++ language ++ "_" ++ n recName = "rec_" ++ language ++ "_" ++ n
print opts
writeFile "debug.net" slf writeFile "debug.net" slf
initATK language initATK language
hPutStrLn stderr "Loading grammar..." hPutStrLn stderr "Loading grammar..."
loadGrammarString slfName slf loadGrammarString slfName slf
createRecognizer recName hmmName dictName slfName createRecognizer recName hmmName dictName slfName
hPutStrLn stderr "Listening..." hPutStrLn stderr "Listening..."
s <- recognize recName s <- replicateM number (recognize recName)
return s 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.Infra.Option (Options)
import GF.Conversion.Types (CGrammar) import GF.Conversion.Types (CGrammar)
recognizeSpeech :: Ident -- ^ Grammar name recognizeSpeech :: Ident -- ^ Grammar name
-> Options -> CGrammar -> IO String -> String -- ^ Language, e.g. en_UK
recognizeSpeech _ _ _ = fail "No speech input available" -> 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 Control.Monad
import Data.Char import Data.Char
import Data.Maybe (fromMaybe)
-- character codings -- character codings
import GF.Text.Unicode import GF.Text.Unicode
@@ -254,23 +255,29 @@ customGrammarPrinter =
probs = stateProbs s probs = stateProbs s
in srgsXmlPrinter name opts (Just probs) $ stateCFG s) in srgsXmlPrinter name opts (Just probs) $ stateCFG s)
,(strCI "slf", \s -> let opts = stateOptions s ,(strCI "slf", \s -> let opts = stateOptions s
start = getStartCat opts
name = cncId s name = cncId s
in slfPrinter name opts $ stateCFG s) in slfPrinter name start $ stateCFG s)
,(strCI "slf_graphviz", \s -> let opts = stateOptions s ,(strCI "slf_graphviz", \s -> let opts = stateOptions s
start = getStartCat opts
name = cncId s name = cncId s
in slfGraphvizPrinter name opts $ stateCFG s) in slfGraphvizPrinter name start $ stateCFG s)
,(strCI "slf_sub", \s -> let opts = stateOptions s ,(strCI "slf_sub", \s -> let opts = stateOptions s
start = getStartCat opts
name = cncId s name = cncId s
in slfSubPrinter name opts $ stateCFG s) in slfSubPrinter name start $ stateCFG s)
,(strCI "slf_sub_graphviz", \s -> let opts = stateOptions s ,(strCI "slf_sub_graphviz", \s -> let opts = stateOptions s
start = getStartCat opts
name = cncId s name = cncId s
in slfSubGraphvizPrinter name opts $ stateCFG s) in slfSubGraphvizPrinter name start $ stateCFG s)
,(strCI "fa_graphviz", \s -> let opts = stateOptions s ,(strCI "fa_graphviz", \s -> let opts = stateOptions s
start = getStartCat opts
name = cncId s name = cncId s
in faGraphvizPrinter name opts $ stateCFG s) in faGraphvizPrinter name start $ stateCFG s)
,(strCI "fa_c", \s -> let opts = stateOptions s ,(strCI "fa_c", \s -> let opts = stateOptions s
start = getStartCat opts
name = cncId s name = cncId s
in faCPrinter name opts $ stateCFG s) in faCPrinter name start $ stateCFG s)
,(strCI "regular", regularPrinter . stateCFG) ,(strCI "regular", regularPrinter . stateCFG)
,(strCI "plbnf", prLBNF True) ,(strCI "plbnf", prLBNF True)
,(strCI "lbnf", prLBNF False) ,(strCI "lbnf", prLBNF False)
@@ -321,7 +328,8 @@ customGrammarPrinter =
-- ,(strCI "cfg-old", PrtOld.prt . CnvOld.cfg . statePInfoOld) -- ,(strCI "cfg-old", PrtOld.prt . CnvOld.cfg . statePInfoOld)
] ]
where stateGrammarLangOpts s = (stateOptions s, stateGrammarLang s) where stateGrammarLangOpts s = (stateOptions s, stateGrammarLang s)
getStartCat :: Options -> String
getStartCat opts = fromMaybe "S" (getOptVal opts gStartCat) ++ "{}.s"
customMultiGrammarPrinter = customMultiGrammarPrinter =
customData "Printers for multiple grammars, selected by option -printer=x" $ customData "Printers for multiple grammars, selected by option -printer=x" $