summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/compiler/GF/Command/Commands.hs39
-rw-r--r--src/runtime/haskell/PGF.hs6
-rw-r--r--src/runtime/haskell/PGF/Generate.hs23
3 files changed, 53 insertions, 15 deletions
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
generated by cgit v1.2.3 (git 2.39.1) at 2026-05-20 16:58:04 +0000