gt and gr can start from a tree with metavariables, just filling them

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 {

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
 

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