Improved gt; Karin C's examples.

src/GF/API.hs

@@ -157,15 +157,16 @@ randomTreesIO opts gr n = do
    g   = grammar gr
    mx  = optIntOrN opts flagDepth 41
 
-generateTrees :: Options -> GFGrammar -> Int -> [Tree]
-generateTrees opts gr n =
+generateTrees :: Options -> GFGrammar -> [Tree]
+generateTrees opts gr =
   optIntOrAll opts flagNumber  
-    [tr | t <- Gen.generateTrees gr' cat n, Ok tr <- [mkTr t]]
+    [tr | t <- Gen.generateTrees gr' cat dpt mn, Ok tr <- [mkTr t]]
   where
     mkTr = annotate gr' . qualifTerm (absId gr) 
     gr' = grammar gr
     cat = firstAbsCat opts gr
-
+    dpt = maybe 3 id $ getOptInt opts flagDepth
+    mn  = getOptInt opts flagAlts
 
 speechGenerate :: Options -> String -> IO ()
 speechGenerate opts str = do

src/GF/Infra/Option.hs

@@ -221,7 +221,8 @@ flagYes = oArg "yes"
 flagNo  = oArg "no"
 
 -- integer flags
-flagDepth = aOpt "depth"
+flagDepth  = aOpt "depth"
+flagAlts   = aOpt "alts"
 flagLength = aOpt "length"
 flagNumber = aOpt "number"
 

src/GF/Shell.hs

@@ -53,8 +53,8 @@ data Command =
  | CLinearize [()] ---- parameters
  | CParse
  | CTranslate Language Language
- | CGenerateRandom Int
- | CGenerateTrees Int
+ | CGenerateRandom
+ | CGenerateTrees
  | CPutTerm
  | CWrapTerm Ident
  | CMorphoAnalyse
@@ -174,7 +174,7 @@ execC co@(comm, opts0) sa@((st,(h,_)),a) = case comm of
   CTranslate il ol -> do
     let a' = opST2CommandArg (optParseArgErr opts (sgr il)) a
     returnArg (opTS2CommandArg (optLinearizeTreeVal opts (sgr ol)) a') sa
-  CGenerateRandom n -> do
+  CGenerateRandom -> do
     let 
       a' = case a of
         ASTrm _ -> s2t a
@@ -186,9 +186,9 @@ execC co@(comm, opts0) sa@((st,(h,_)),a) = case comm of
               Ok trm' -> returnArg (ATrms [loc2tree trm']) sa
               Bad s   -> returnArg (AError s) sa
       _ -> do
-        ts <- randomTreesIO opts gro (optIntOrN opts flagNumber n)
+        ts <- randomTreesIO opts gro (optIntOrN opts flagNumber 1)
         returnArg (ATrms ts) sa
-  CGenerateTrees n -> returnArg (ATrms $ generateTrees opts gro n) sa
+  CGenerateTrees -> returnArg (ATrms $ generateTrees opts gro) sa
 
 
   CPutTerm -> changeArg (opTT2CommandArg (optTermCommand opts gro) . s2t) sa

src/GF/Shell/PShell.hs

@@ -70,9 +70,9 @@ pCommand ws = case ws of
 
   "p"  : s      -> aString CParse s
   "t"  : i:o: s -> aString (CTranslate (language i) (language o)) s
-  "gr" : []     -> aUnit   (CGenerateRandom 1)
-  "gr" : t      -> aTerm   (CGenerateRandom 1) t
-  "gt" : n : [] -> aUnit   (CGenerateTrees (readIntArg n))
+  "gr" : []     -> aUnit   CGenerateRandom
+  "gr" : t      -> aTerm   CGenerateRandom t
+  "gt" : []     -> aUnit   CGenerateTrees
   "pt" : s      -> aTerm   CPutTerm s
 -----  "wt" : f : s  -> aTerm   (CWrapTerm (string2id f)) s
   "ma" : s      -> aString CMorphoAnalyse s

src/GF/UseGrammar/Generate.hs

@@ -17,8 +17,8 @@ import List
 
 -- the main function takes an abstract syntax and returns a list of trees
 
--- generateTrees :: GFCGrammar -> Cat -> Int -> [Exp]
-generateTrees gr cat n = map str2tr $ generate gr' cat' n where
+-- generateTrees :: GFCGrammar -> Cat -> Int -> Maybe Int -> [Exp]
+generateTrees gr cat n mn = map str2tr $ generate gr' cat' n mn where
   gr' = gr2sgr gr
   cat' = prt $ snd cat
 
@@ -39,17 +39,22 @@ str2tr (STr (f,ts)) = mkApp (trId f) (map str2tr ts) where
 
 ------------------------------------------
 -- do the main thing with a simpler data structure
+-- the first Int gives tree depth, the second constrains subtrees
+-- chosen for each branch. A small number, such as 2, is a good choice
+-- if the depth is large (more than 3)
 
-generate :: SGrammar -> SCat -> Int -> [STree]
-generate gr cat i = [t | (c,t) <- gen 0 [], c == cat] where
+
+generate :: SGrammar -> SCat -> Int -> Maybe Int -> [STree]
+generate gr cat i mn = [t | (c,t) <- gen 0 [], c == cat] where
 
   gen :: Int -> [(SCat,STree)] -> [(SCat,STree)]
   gen n cts = if n==i then cts else
     gen (n+1) (nub [(c,STr (f, xs)) | (f,(cs,c)) <- gr, xs <- args cs cts] ++ cts)
 
   args :: [SCat] -> [(SCat,STree)] -> [[STree]]
-  args cs cts = combinations [[t | (k,t) <- cts, k == c] | c <- cs]
+  args cs cts = combinations [constr [t | (k,t) <- cts, k == c] | c <- cs]
 
+  constr = maybe id take mn
 
 type SGrammar = [SRule]
 type SIdent = String

src/HelpFile

@@ -162,9 +162,12 @@ gr, generate_random: gr Tree?
       -number  generate this number of trees (not impl. with Tree argument)
       -depth   use this number of search steps at most
 
-gt, generate_trees: gt Int
-      Generates all trees up to the given depth.
+gt, generate_trees: gt
+      Generates all trees up to a given depth. If the depth is large,
+      a small -alts is recommended
   flags:
+      -depth   generate to this depth (default 3)
+      -alts    take this number of alternatives at each branch (default unlimited)
       -cat     generate in this category
       -lang    use the abstract syntax of this grammar
       -number  generate (at most) this number of trees

src/HelpFile.hs

@@ -175,9 +175,12 @@ txtHelpFile =
   "\n      -number  generate this number of trees (not impl. with Tree argument)" ++
   "\n      -depth   use this number of search steps at most" ++
   "\n" ++
-  "\ngt, generate_trees: gt Int" ++
-  "\n      Generates all trees up to the given depth." ++
+  "\ngt, generate_trees: gt" ++
+  "\n      Generates all trees up to a given depth. If the depth is large," ++
+  "\n      a small -alts is recommended" ++
   "\n  flags:" ++
+  "\n      -depth   generate to this depth (default 3)" ++
+  "\n      -alts    take this number of alternatives at each branch (default unlimited)" ++
   "\n      -cat     generate in this category" ++
   "\n      -lang    use the abstract syntax of this grammar" ++
   "\n      -number  generate (at most) this number of trees" ++

src/Today.hs

@@ -1 +1 @@
-module Today where today = "Fri Apr 30 18:14:29 CEST 2004"
+module Today where today = "Fri Apr 30 21:40:30 CEST 2004"