summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src-3.0/GF/Command/Commands.hs26
-rw-r--r--src-3.0/GF/Compile/GrammarToGFCC.hs2
-rw-r--r--src-3.0/PGF/Quiz.hs76
-rw-r--r--src-3.0/PGF/ShowLinearize.hs1
4 files changed, 103 insertions, 2 deletions
diff --git a/src-3.0/GF/Command/Commands.hs b/src-3.0/GF/Command/Commands.hs
index b37143c90..4d9020d87 100644
--- a/src-3.0/GF/Command/Commands.hs
+++ b/src-3.0/GF/Command/Commands.hs
@@ -15,6 +15,7 @@ import PGF.ShowLinearize
import PGF.Macros
import PGF.Data ----
import PGF.Morphology
+import PGF.Quiz
import GF.Compile.Export
import GF.Infra.UseIO
import GF.Data.ErrM ----
@@ -167,6 +168,17 @@ allCommands pgf = Map.fromList [
concatMap words . toStrings
}),
+ ("mq", emptyCommandInfo {
+ longname = "morpho_quiz",
+ synopsis = "start a morphology quiz",
+ exec = \opts _ -> do
+ let lang = optLang opts
+ let cat = optCat opts
+ morphologyQuiz pgf lang cat
+ return void,
+ flags = ["lang","cat","number"]
+ }),
+
("p", emptyCommandInfo {
longname = "parse",
synopsis = "parse a string to abstract syntax expression",
@@ -245,6 +257,17 @@ allCommands pgf = Map.fromList [
_ -> fromString s,
flags = ["file"]
}),
+ ("tq", emptyCommandInfo {
+ longname = "translation_quiz",
+ synopsis = "start a translation quiz",
+ exec = \opts _ -> do
+ let from = valIdOpts "from" (optLang opts) opts
+ let to = valIdOpts "to" (optLang opts) opts
+ let cat = optCat opts
+ translationQuiz pgf from to cat
+ return void,
+ flags = ["from","to","cat","number"]
+ }),
("wf", emptyCommandInfo {
longname = "write_file",
synopsis = "send string or tree to a file",
@@ -276,7 +299,8 @@ allCommands pgf = Map.fromList [
optLangs opts = case valIdOpts "lang" "" opts of
"" -> languages pgf
- lang -> [lang]
+ lang -> [lang]
+ optLang opts = head $ optLangs opts ++ ["#NOLANG"]
optCat opts = valIdOpts "cat" (lookStartCat pgf) opts
optNum opts = valIntOpts "number" 1 opts
optNumInf opts = valIntOpts "number" 1000000000 opts ---- 10^9
diff --git a/src-3.0/GF/Compile/GrammarToGFCC.hs b/src-3.0/GF/Compile/GrammarToGFCC.hs
index a27b4e761..010393bfd 100644
--- a/src-3.0/GF/Compile/GrammarToGFCC.hs
+++ b/src-3.0/GF/Compile/GrammarToGFCC.hs
@@ -279,7 +279,7 @@ canon2canon abs =
(c, M.ModMod $ M.replaceJudgements mo $ mapTree f2 (M.jments mo))
_ -> (c,m)
j2j cg (f,j) = case j of
- CncFun x (Yes tr) z -> (f,CncFun x (Yes (trace ("+ " ++ prt f) (t2t tr))) z)
+ CncFun x (Yes tr) z -> (f,CncFun x (Yes ({-trace ("+ " ++ prt f)-} (t2t tr))) z)
CncCat (Yes ty) (Yes x) y -> (f,CncCat (Yes (ty2ty ty)) (Yes (t2t x)) y)
_ -> (f,j)
where
diff --git a/src-3.0/PGF/Quiz.hs b/src-3.0/PGF/Quiz.hs
new file mode 100644
index 000000000..a9aba51cf
--- /dev/null
+++ b/src-3.0/PGF/Quiz.hs
@@ -0,0 +1,76 @@
+----------------------------------------------------------------------
+-- |
+-- Module : TeachYourself
+-- Maintainer : AR
+-- Stability : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:46:13 $
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.7 $
+--
+-- translation and morphology quiz. AR 10\/5\/2000 -- 12\/4\/2002 -- 14\/6\/2008
+--------------------------------------------------------------------------------
+
+module PGF.Quiz (
+ translationQuiz,
+ translationList,
+ morphologyQuiz,
+ morphologyList
+ ) where
+
+import PGF
+import PGF.ShowLinearize
+
+import GF.Data.Operations
+import GF.Infra.UseIO
+
+import System.Random
+
+import Data.List (nub)
+
+-- translation and morphology quiz. AR 10/5/2000 -- 12/4/2002
+
+translationQuiz :: PGF -> Language -> Language -> Category -> IO ()
+translationQuiz pgf ig og cat = do
+ tts <- translationList pgf ig og cat infinity
+ let qas = [ (q, mkAnswer as) | (q,as) <- tts]
+ teachDialogue qas "Welcome to GF Translation Quiz."
+
+translationList :: PGF -> Language -> Language -> Category -> Int -> IO [(String,[String])]
+translationList pgf ig og cat number = do
+ ts <- generateRandom pgf cat >>= return . take number
+ return $ map mkOne $ ts
+ where
+ mkOne t = (norml (linearize pgf ig t), map (norml . linearize pgf og) (homonyms t))
+ homonyms = nub . parse pgf ig cat . linearize pgf ig
+
+morphologyQuiz :: PGF -> Language -> Category -> IO ()
+morphologyQuiz pgf ig cat = do
+ tts <- morphologyList pgf ig cat infinity
+ let qas = [ (q, mkAnswer as) | (q,as) <- tts]
+ teachDialogue qas "Welcome to GF Morphology Quiz."
+
+morphologyList :: PGF -> Language -> Category -> Int -> IO [(String,[String])]
+morphologyList pgf ig cat number = do
+ ts <- generateRandom pgf cat >>= return . take (max 1 number)
+ gen <- newStdGen
+ let ss = map (tabularLinearize pgf (mkCId ig)) ts
+ let size = length (head ss)
+ let forms = take number $ randomRs (0,size-1) gen
+ return [(head (snd (head pws)) +++ par, ws) |
+ (pws,i) <- zip ss forms, let (par,ws) = pws !! i]
+
+-- | compare answer to the list of right answers, increase score and give feedback
+mkAnswer :: [String] -> String -> (Integer, String)
+mkAnswer as s = if (elem (norml s) as)
+ then (1,"Yes.")
+ else (0,"No, not" +++ s ++ ", but" ++++ unlines as)
+
+norml :: String -> String
+norml = unwords . words
+
+-- | the maximal number of precompiled quiz problems
+infinity :: Int
+infinity = 256
+
diff --git a/src-3.0/PGF/ShowLinearize.hs b/src-3.0/PGF/ShowLinearize.hs
index 82eda2824..8c01c3ddd 100644
--- a/src-3.0/PGF/ShowLinearize.hs
+++ b/src-3.0/PGF/ShowLinearize.hs
@@ -3,6 +3,7 @@ module PGF.ShowLinearize (
tableLinearize,
recordLinearize,
termLinearize,
+ tabularLinearize,
allLinearize
) where