diff --git a/src/compiler/GF/Command/Commands.hs b/src/compiler/GF/Command/Commands.hs index 3d97f545a..a9a472552 100644 --- a/src/compiler/GF/Command/Commands.hs +++ b/src/compiler/GF/Command/Commands.hs @@ -977,8 +977,8 @@ allCommands env@(pgf, mos) = Map.fromList [ optProbs opts pgfr = case valStrOpts "probs" "" opts of "" -> return Nothing file -> do - ps <- getProbsFromFile file pgf ---- pgfr! --- putStrLn $ prProbabilities ps + ps <- readProbabilitiesFromFile file pgf ---- pgfr! +-- putStrLn $ showProbabilities ps return $ Just ps optFile opts = valStrOpts "file" "_gftmp" opts diff --git a/src/runtime/haskell/PGF.hs b/src/runtime/haskell/PGF.hs index 0a110f83d..0e9f7c098 100644 --- a/src/runtime/haskell/PGF.hs +++ b/src/runtime/haskell/PGF.hs @@ -99,6 +99,13 @@ module PGF( graphvizBracketedString, graphvizAlignment, + -- * Probabilities + Probabilities, + mkProbabilities, + defaultProbabilities, + showProbabilities, + readProbabilitiesFromFile, + -- * Browsing browse ) where @@ -109,6 +116,7 @@ import PGF.Generate import PGF.TypeCheck import PGF.Paraphrase import PGF.VisualizeTree +import PGF.Probabilistic import PGF.Macros import PGF.Expr (Tree) import PGF.Morphology diff --git a/src/runtime/haskell/PGF/Probabilistic.hs b/src/runtime/haskell/PGF/Probabilistic.hs index e42698cfe..542ccd519 100644 --- a/src/runtime/haskell/PGF/Probabilistic.hs +++ b/src/runtime/haskell/PGF/Probabilistic.hs @@ -1,12 +1,13 @@ -module PGF.Probabilistic ( - probTree -- :: Probabilities -> Tree -> Double - ,rankTreesByProbs -- :: Probabilities -> [Tree] -> [Tree] - ,Probabilities -- data - ,prProbabilities -- Probabilities -> String - ,catProbs - ,getProbsFromFile -- :: FilePath -> PGF -> IO Probabilities - ,defaultProbabilities -- :: PGF -> Probabilities - ) where +module PGF.Probabilistic + ( Probabilities(..) + , mkProbabilities -- :: PGF -> M.Map CId Double -> Probabilities + , defaultProbabilities -- :: PGF -> Probabilities + , showProbabilities -- :: Probabilities -> String + , readProbabilitiesFromFile -- :: FilePath -> PGF -> IO Probabilities + + , probTree -- :: Probabilities -> Tree -> Double + , rankTreesByProbs -- :: Probabilities -> [Tree] -> [Tree] + ) where import PGF.CId import PGF.Data @@ -15,25 +16,34 @@ import PGF.Macros import qualified Data.Map as M import Data.List (sortBy,partition) +-- | An abstract data structure which represents +-- the probabilities for the different functions in a grammar. data Probabilities = Probs { funProbs :: M.Map CId Double, catProbs :: M.Map CId [(Double, (CId,[CId]))] -- prob and arglist } -prProbabilities :: Probabilities -> String -prProbabilities = unlines . map pr . M.toList . funProbs where +-- | Renders the probability structure as string +showProbabilities :: Probabilities -> String +showProbabilities = unlines . map pr . M.toList . funProbs where pr (f,d) = showCId f ++ "\t" ++ show d -getProbsFromFile :: FilePath -> PGF -> IO Probabilities -getProbsFromFile file pgf = do +-- | Reads the probabilities from a file. +-- This should be a text file where on every line +-- there is a function name followed by a real number. +-- The number represents the probability mass allocated for that function. +-- The function name and the probability should be separated by a whitespace. +readProbabilitiesFromFile :: FilePath -> PGF -> IO Probabilities +readProbabilitiesFromFile file pgf = do s <- readFile file let ps0 = M.fromList [(mkCId f,read p) | f:p:_ <- map words (lines s)] - return $ fillProbs pgf ps0 + return $ mkProbabilities pgf ps0 --- | build probability tables by filling unspecified funs with prob sum --- TODO: check that probabilities sum to 1 -fillProbs :: PGF -> M.Map CId Double -> Probabilities -fillProbs pgf funs = +-- | Builds probability tables by filling unspecified funs with probability sum +-- +-- TODO: check that probabilities sum to 1 +mkProbabilities :: PGF -> M.Map CId Double -> Probabilities +mkProbabilities pgf funs = let cats0 = [(cat,[(f,fst (catSkeleton ty)) | (f,ty) <- fs]) | (cat,_) <- M.toList (cats (abstract pgf)), @@ -54,8 +64,9 @@ fillProbs pgf funs = _ -> (1 - sum poss) / fromIntegral (length negs) (poss,negs) = partition (> (-0.5)) (map fst pfs) +-- | Returns the default even distibution. defaultProbabilities :: PGF -> Probabilities -defaultProbabilities pgf = fillProbs pgf M.empty +defaultProbabilities pgf = mkProbabilities pgf M.empty -- | compute the probability of a given tree probTree :: Probabilities -> Expr -> Double