commands mq and tq can take a tree with metas to guide generation

src/compiler/GF/Command/Commands.hs

@@ -287,9 +287,7 @@ allCommands cod env@(pgf, mos) = Map.fromList [
        let pgfr = optRestricted opts
        gen <- newStdGen
        mprobs <- optProbs opts pgfr
-       let mt = case xs of
+       let mt = mexp xs
-            t:_ -> Just t
-            _   -> Nothing
        ts <- return $ generateRandomFrom mt mprobs gen pgfr (optType opts)
        returnFromExprs $ take (optNum opts) ts
      }),
@@ -317,9 +315,7 @@ allCommands cod env@(pgf, mos) = Map.fromList [
      exec = \opts xs -> do
        let pgfr = optRestricted opts
        let dp = return $ valIntOpts "depth" 4 opts
-       let mt = case xs of
+       let mt = mexp xs
-            t:_ -> Just t
-            _   -> Nothing
        let ts = generateAllDepth mt pgfr (optType opts) dp
        returnFromExprs $ take (optNumInf opts) ts
      }),
@@ -430,15 +426,19 @@ allCommands cod env@(pgf, mos) = Map.fromList [
   ("mq", emptyCommandInfo {
      longname = "morpho_quiz",
      synopsis = "start a morphology quiz",
-     exec = \opts _ -> do
+     syntax   = "mq (-cat=CAT)? (-probs=FILE)? TREE?", 
+     exec = \opts xs -> do
          let lang = optLang opts
          let typ  = optType opts
-         morphologyQuiz cod pgf lang typ
+         mprobs <- optProbs opts pgf
+         let mt = mexp xs 
+         morphologyQuiz mt mprobs cod pgf lang typ
          return void,
      flags = [
        ("lang","language of the quiz"),
        ("cat","category of the quiz"),
-       ("number","maximum number of questions")
+       ("number","maximum number of questions"),
+       ("probs","file with biased probabilities for generation")
        ]
      }),
 
@@ -622,18 +622,26 @@ allCommands cod env@(pgf, mos) = Map.fromList [
      }),
   ("tq", emptyCommandInfo {
      longname = "translation_quiz",
+     syntax   = "tq -from=LANG -to=LANG (-cat=CAT)? (-probs=FILE)? TREE?",
      synopsis = "start a translation quiz",
-     exec = \opts _ -> do
+     exec = \opts xs -> do
          let from = valCIdOpts "from" (optLang opts) opts
          let to   = valCIdOpts "to"   (optLang opts) opts
          let typ  = optType opts
-         translationQuiz cod pgf from to typ
+         let mt   = mexp xs
+         mprobs <- optProbs opts pgf
+         translationQuiz mt mprobs cod pgf from to typ
          return void,
      flags = [
        ("from","translate from this language"),
        ("to","translate to this language"),
        ("cat","translate in this category"),
-       ("number","the maximum number of questions")
+       ("number","the maximum number of questions"),
+       ("probs","file with biased probabilities for generation")
+       ], 
+     examples = [
+       ("tq -from=Eng -to=Swe                               -- any trees in startcat"),
+       ("tq -from=Eng -to=Swe (AdjCN (PositA ?2) (UseN ?))  -- only trees of this form")
        ] 
      }),
   ("se", emptyCommandInfo {
@@ -970,6 +978,10 @@ allCommands cod env@(pgf, mos) = Map.fromList [
 
    optMorpho opts = morpho (error "no morpho") id (head (optLangs opts))
 
+   mexp xs = case xs of
+     t:_ -> Just t
+     _   -> Nothing
+
    -- ps -f -g s returns g (f s)
    stringOps menv opts s = foldr (menvop . app) s (reverse opts) where
      app f = maybe id id (stringOp f) 
@@ -1014,14 +1026,16 @@ stringOpOptions = sort $ [
 treeOpOptions pgf = [(op,expl) | (op,(expl,Left  _)) <- allTreeOps pgf]
 treeOpFlags   pgf = [(op,expl) | (op,(expl,Right _)) <- allTreeOps pgf]
 
-translationQuiz :: Encoding -> PGF -> Language -> Language -> Type -> IO ()
+translationQuiz :: Maybe Expr -> Maybe Probabilities -> Encoding -> 
-translationQuiz cod pgf ig og typ = do
+                   PGF -> Language -> Language -> Type -> IO ()
-  tts <- translationList pgf ig og typ infinity
+translationQuiz mex mprobs cod pgf ig og typ = do
+  tts <- translationList mex mprobs pgf ig og typ infinity
   mkQuiz cod "Welcome to GF Translation Quiz." tts
 
-morphologyQuiz :: Encoding -> PGF -> Language -> Type -> IO ()
+morphologyQuiz :: Maybe Expr -> Maybe Probabilities -> Encoding -> 
-morphologyQuiz cod pgf ig typ = do
+                  PGF -> Language -> Type -> IO ()
-  tts <- morphologyList pgf ig typ infinity
+morphologyQuiz mex mprobs cod pgf ig typ = do
+  tts <- morphologyList mex mprobs pgf ig typ infinity
   mkQuiz cod "Welcome to GF Morphology Quiz." tts
 
 -- | the maximal number of precompiled quiz problems

src/compiler/GF/Quiz.hs

@@ -24,9 +24,9 @@ import GF.Data.Operations
 import GF.Infra.UseIO
 import GF.Infra.Option
 import GF.Text.Coding
+import PGF.Probabilistic
 
 import System.Random
-
 import Data.List (nub)
 
 -- translation and morphology quiz. AR 10/5/2000 -- 12/4/2002
@@ -39,18 +39,22 @@ mkQuiz cod msg tts = do
   teachDialogue qas msg
 
 translationList :: 
+  Maybe Expr -> Maybe Probabilities -> 
   PGF -> Language -> Language -> Type -> Int -> IO [(String,[String])]
-translationList pgf ig og typ number = do
+translationList mex mprobs pgf ig og typ number = do
-  ts <- generateRandom pgf typ >>= return . take number
+  gen <- newStdGen
+  let ts = take number $ generateRandomFrom mex mprobs gen pgf typ
   return $ map mkOne $ ts
  where
    mkOne t = (norml (linearize pgf ig t), map (norml . linearize pgf og) (homonyms t))
    homonyms = nub . parse pgf ig typ . linearize pgf ig
 
-morphologyList :: PGF -> Language -> Type -> Int -> IO [(String,[String])]
+morphologyList :: 
-morphologyList pgf ig typ number = do
+  Maybe Expr -> Maybe Probabilities -> 
-  ts  <- generateRandom pgf typ >>= return . take (max 1 number)
+  PGF -> Language -> Type -> Int -> IO [(String,[String])]
+morphologyList mex mprobs pgf ig typ number = do
   gen <- newStdGen
+  let ts = take (max 1 number) $ generateRandomFrom mex mprobs gen pgf typ 
   let ss    = map (tabularLinearizes pgf ig) ts
   let size  = length (head (head ss))
   let forms = take number $ randomRs (0,size-1) gen

src/runtime/haskell/PGF.hs

@@ -79,6 +79,7 @@ module PGF(
 
            -- ** Generation
            generateRandom, generateAll, generateAllDepth,
+           generateRandomFrom, -- from initial expression, possibly weighed
 
            -- ** Morphological Analysis
            Lemma, Analysis, Morpho,

src/runtime/haskell/PGF/Generate.hs

@@ -21,6 +21,10 @@ generateRandomFrom mex ps rg pgf ty =
   maybe (gen ty) (generateForMetas pgf gen) mex where
     gen ty = genRandomProb ps rg pgf ty
 
+
+-- generic algorithm for filling holes in a generator
+---- for random, should be breadth-first, since now the first metas always get the same
+---- value when a list is generated
 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]