Documented SRGS XML generation. Started working on support for probabilities in SRG generation. Added support for probabilities in for SRGS.

src/GF/Speech/SRG.hs

@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/10/26 17:14:03 $ 
+-- > CVS $Date: 2005/11/01 20:09:04 $ 
 -- > CVS $Author: bringert $
--- > CVS $Revision: 1.19 $
+-- > CVS $Revision: 1.20 $
 --
 -- Representation of, conversion to, and utilities for 
 -- printing of a general Speech Recognition Grammar. 
@@ -20,6 +20,7 @@
 
 module GF.Speech.SRG where
 
+import GF.Data.Operations
 import GF.Data.Utilities
 import GF.Infra.Ident
 import GF.Formalism.CFG
@@ -28,6 +29,7 @@ import GF.Conversion.Types
 import GF.Infra.Print
 import GF.Speech.TransformCFG
 import GF.Infra.Option
+import GF.Probabilistic.Probabilistic (Probs)
 
 import Data.List
 import Data.Maybe (fromMaybe)
@@ -38,9 +40,15 @@ data SRG = SRG { grammarName :: String    -- ^ grammar name
 		 , origStartCat :: String -- ^ original start category name
 	         , rules :: [SRGRule] 
 	       }
+	 deriving (Eq,Show)
+
 data SRGRule = SRGRule String String [SRGAlt] -- ^ SRG category name, original category name
 	                                      --   and productions
-type SRGAlt = [Symbol String Token]
+	     deriving (Eq,Show)
+
+-- | maybe a probability, and a list of symbols
+data SRGAlt = SRGAlt (Maybe Double) [Symbol String Token]
+	      deriving (Eq,Show)
 
 -- | SRG category name and original name
 type CatName = (String,String) 
@@ -49,27 +57,42 @@ type CatNames = FiniteMap String String
 
 makeSRG :: Ident     -- ^ Grammar name
 	-> Options   -- ^ Grammar options
+	-> Maybe Probs -- ^ Probabilities
 	-> CGrammar -- ^ A context-free grammar
 	-> SRG
-makeSRG i opts gr = SRG { grammarName = name,
-			  startCat = lookupFM_ names origStart,
-			  origStartCat = origStart,
-			  rules = map (cfgRulesToSRGRule names) cfgRules }
+makeSRG i opts probs gr 
+    = SRG { grammarName = name,
+	    startCat = lookupFM_ names origStart,
+	    origStartCat = origStart,
+	    rules = rs }
     where 
     name = prIdent i
     origStart = getStartCat opts
     gr' = removeLeftRecursion $ removeIdenticalRules $ removeEmptyCats $ cfgToCFRules gr
     (cats,cfgRules) = unzip gr'
     names = mkCatNames name cats
+    rs = map (cfgRulesToSRGRule names probs) cfgRules
 
-cfgRulesToSRGRule :: FiniteMap String String -> [CFRule_] -> SRGRule
-cfgRulesToSRGRule names rs@(r:_) = SRGRule cat origCat rhs
+
+-- FIXME: probabilities get larger than 1.0 when new rules are
+-- introduced
+-- FIXME: merge alternatives with same rhs but different probabilities
+cfgRulesToSRGRule :: FiniteMap String String -> Maybe Probs -> [CFRule_] -> SRGRule
+cfgRulesToSRGRule names probs rs@(r:_) = SRGRule cat origCat rhs
     where origCat = lhsCat r
 	  cat = lookupFM_ names origCat
-	  rhs = nub $ map (map renameCat . ruleRhs) rs
+	  rhs = nub $ map ruleToAlt rs
+	  ruleToAlt r = SRGAlt (ruleProb probs r) (map renameCat (ruleRhs r))
 	  renameCat (Cat c) = Cat (lookupFM_ names c)
 	  renameCat t = t
 
+ruleProb :: Maybe Probs -> CFRule_ -> Maybe Double
+ruleProb mp r = mp >>= \probs -> lookupProb probs (ruleFun r)
+
+-- FIXME: move to GF.Probabilistic.Probabilistic?
+lookupProb :: Probs -> Ident -> Maybe Double
+lookupProb probs i = lookupTree prIdent i probs
+
 mkCatNames :: String   -- ^ Category name prefix
 	   -> [String] -- ^ Original category names
 	   -> FiniteMap String String -- ^ Maps original names to SRG names