diff --git a/src/compiler/GF/Command/Commands.hs b/src/compiler/GF/Command/Commands.hs index 27c4886c8..c282ed45f 100644 --- a/src/compiler/GF/Command/Commands.hs +++ b/src/compiler/GF/Command/Commands.hs @@ -21,7 +21,7 @@ import PGF.Data ---- import PGF.Morphology import PGF.Printer import PGF.Probabilistic -- (getProbsFromFile,prProbabilities,defaultProbabilities) -import PGF.Generate (genRandomProb) ---- +import PGF.Generate (generateRandomFrom) ---- import GF.Compile.Export import GF.Compile.ExampleBased import GF.Infra.Option (noOptions, readOutputFormat, Encoding(..)) @@ -267,12 +267,15 @@ allCommands cod env@(pgf, mos) = Map.fromList [ examples = [ "gr -- one tree in the startcat of the current grammar", "gr -cat=NP -number=16 -- 16 trees in the category NP", - "gr -lang=LangHin,LangTha -cat=Cl -- Cl, both in LangHin and LangTha" + "gr -lang=LangHin,LangTha -cat=Cl -- Cl, both in LangHin and LangTha", + "gr -probs=FILE -- generate with bias", + "gr (AdjCN ? (UseN ?)) -- generate trees of form (AdjCN ? (UseN ?))" ], explanation = unlines [ - "Generates a list of random trees, by default one tree." ----- "If a tree argument is given, the command completes the Tree with values to", ----- "the metavariables in the tree." + "Generates a list of random trees, by default one tree.", + "If a tree argument is given, the command completes the Tree with values to", + "all metavariables in the tree. The generation can be biased by probabilities,", + "given in a file in the -probs flag." ], flags = [ ("cat","generation category"), @@ -280,11 +283,14 @@ allCommands cod env@(pgf, mos) = Map.fromList [ ("number","number of trees generated"), ("probs", "file with biased probabilities (format 'f 0.4' one by line)") ], - exec = \opts _ -> do + exec = \opts xs -> do let pgfr = optRestricted opts gen <- newStdGen mprobs <- optProbs opts pgfr - ts <- return $ genRandomProb mprobs gen pgfr (optType opts) + let mt = case xs of + t:_ -> Just t + _ -> Nothing + ts <- return $ generateRandomFrom mt mprobs gen pgfr (optType opts) returnFromExprs $ take (optNum opts) ts }), ("gt", emptyCommandInfo { @@ -292,9 +298,9 @@ allCommands cod env@(pgf, mos) = Map.fromList [ synopsis = "generates a list of trees, by default exhaustive", explanation = unlines [ "Generates all trees of a given category, with increasing depth.", - "By default, the depth is 4, but this can be changed by a flag." - ---- "If a Tree argument is given, the command completes the Tree with values", - ---- "to the metavariables in the tree." + "By default, the depth is 4, but this can be changed by a flag.", + "If a Tree argument is given, the command completes the Tree with values", + "to all metavariables in the tree." ], flags = [ ("cat","the generation category"), @@ -302,10 +308,19 @@ allCommands cod env@(pgf, mos) = Map.fromList [ ("lang","excludes functions that have no linearization in this language"), ("number","the number of trees generated") ], - exec = \opts _ -> do + examples = [ + "gt -- all trees in the startcat, to depth 4", + "gt -cat=NP -number=16 -- 16 trees in the category NP", + "gt -cat=NP -depth=2 -- trees in the category NP to depth 2", + "gt (AdjCN ? (UseN ?)) -- trees of form (AdjCN ? (UseN ?))" + ], + exec = \opts xs -> do let pgfr = optRestricted opts let dp = return $ valIntOpts "depth" 4 opts - let ts = generateAllDepth pgfr (optType opts) dp + let mt = case xs of + t:_ -> Just t + _ -> Nothing + let ts = generateAllDepth mt pgfr (optType opts) dp returnFromExprs $ take (optNumInf opts) ts }), ("h", emptyCommandInfo { diff --git a/src/runtime/haskell/PGF.hs b/src/runtime/haskell/PGF.hs index 2ca152db9..6b6e3b1a3 100644 --- a/src/runtime/haskell/PGF.hs +++ b/src/runtime/haskell/PGF.hs @@ -165,7 +165,7 @@ parseAll :: PGF -> Type -> String -> [[Tree]] parseAllLang :: PGF -> Type -> String -> [(Language,[Tree])] -- | The same as 'generateAllDepth' but does not limit --- the depth in the generation. +-- the depth in the generation, and doesn't give an initial expression. generateAll :: PGF -> Type -> [Expr] -- | Generates an infinite list of random abstract syntax expressions. @@ -176,7 +176,7 @@ generateRandom :: PGF -> Type -> IO [Expr] -- | Generates an exhaustive possibly infinite list of -- abstract syntax expressions. A depth can be specified -- to limit the search space. -generateAllDepth :: PGF -> Type -> Maybe Int -> [Expr] +generateAllDepth :: Maybe Expr -> PGF -> Type -> Maybe Int -> [Expr] -- | List of all languages available in the given grammar. languages :: PGF -> [Language] @@ -248,7 +248,7 @@ generateRandom pgf cat = do return $ genRandom gen pgf cat generateAll pgf cat = generate pgf cat Nothing -generateAllDepth pgf cat = generate pgf cat +generateAllDepth mex pgf cat = generateAllFrom mex pgf cat abstractName pgf = absname pgf diff --git a/src/runtime/haskell/PGF/Generate.hs b/src/runtime/haskell/PGF/Generate.hs index f129150fa..bda64b514 100644 --- a/src/runtime/haskell/PGF/Generate.hs +++ b/src/runtime/haskell/PGF/Generate.hs @@ -9,6 +9,29 @@ import PGF.Probabilistic import qualified Data.Map as M import System.Random +-- generate all fillings of metavariables in an expr +generateAllFrom :: Maybe Expr -> PGF -> Type -> Maybe Int -> [Expr] +generateAllFrom mex pgf ty mi = maybe (gen ty) (generateForMetas pgf gen) mex where + gen ty = generate pgf ty mi + +-- generate random fillings of metavariables in an expr +generateRandomFrom :: Maybe Expr -> + Maybe Probabilities -> StdGen -> PGF -> Type -> [Expr] +generateRandomFrom mex ps rg pgf ty = + maybe (gen ty) (generateForMetas pgf gen) mex where + gen ty = genRandomProb ps rg pgf ty + +generateForMetas :: PGF -> (Type -> [Expr]) -> Expr -> [Expr] +generateForMetas pgf gen exp = case exp of + EApp f (EMeta _) -> [EApp g a | g <- gener f, a <- genArg g] + EApp f x -> [EApp g a | g <- gener f, a <- gener x] + _ -> [exp] + where + gener = generateForMetas pgf gen + genArg f = case inferExpr pgf f of + Right (_,DTyp ((_,_,ty):_) _ _) -> gen ty + _ -> [] + -- generate an infinite list of trees exhaustively generate :: PGF -> Type -> Maybe Int -> [Expr] generate pgf ty@(DTyp _ cat _) dp = filter (\e -> case checkExpr pgf e ty of