Improved gt; Karin C's examples.

5 files changed, 25 insertions, 18 deletions

diff --git a/src/GF/API.hs b/src/GF/API.hs
index 15cccde51..49d7fd5a2 100644
--- a/src/GF/API.hs
+++ b/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
diff --git a/src/GF/Infra/Option.hs b/src/GF/Infra/Option.hs
index abfb44e5a..7e273025f 100644
--- a/src/GF/Infra/Option.hs
+++ b/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"
 
diff --git a/src/GF/Shell.hs b/src/GF/Shell.hs
index 8a0152e10..66a073ebc 100644
--- a/src/GF/Shell.hs
+++ b/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
diff --git a/src/GF/Shell/PShell.hs b/src/GF/Shell/PShell.hs
index b4cd335a7..befdb8ea2 100644
--- a/src/GF/Shell/PShell.hs
+++ b/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
diff --git a/src/GF/UseGrammar/Generate.hs b/src/GF/UseGrammar/Generate.hs
index c39153308..9f8fb66d1 100644
--- a/src/GF/UseGrammar/Generate.hs
+++ b/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