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