From 9837fb8fb17be9ecf5d90f3fb5a97ec6389f9eef Mon Sep 17 00:00:00 2001 From: krasimir Date: Sun, 19 Oct 2008 16:38:56 +0000 Subject: move PGF.Quiz to GF.Quiz. It is not part of the PGF API --- src/GF/Command/Commands.hs | 2 +- src/GF/Infra/UseIO.hs | 28 ------------- src/GF/Quiz.hs | 98 ++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 99 insertions(+), 29 deletions(-) create mode 100644 src/GF/Quiz.hs (limited to 'src/GF') diff --git a/src/GF/Command/Commands.hs b/src/GF/Command/Commands.hs index 57303f53f..e9a2819ba 100644 --- a/src/GF/Command/Commands.hs +++ b/src/GF/Command/Commands.hs @@ -15,7 +15,6 @@ import PGF.ShowLinearize import PGF.Macros import PGF.Data ---- import PGF.Morphology -import PGF.Quiz import PGF.VisualizeTree import GF.Compile.Export import GF.Infra.Option (noOptions) @@ -26,6 +25,7 @@ import GF.Command.Abstract import GF.Command.Messages import GF.Text.Lexing import GF.Text.Transliterations +import GF.Quiz import GF.Command.TreeOperations ---- temporary place for typecheck and compute diff --git a/src/GF/Infra/UseIO.hs b/src/GF/Infra/UseIO.hs index 0ca8d7456..b4cf48f1f 100644 --- a/src/GF/Infra/UseIO.hs +++ b/src/GF/Infra/UseIO.hs @@ -153,34 +153,6 @@ putStrFlush s = putStr s >> hFlush stdout putStrLnFlush :: String -> IO () putStrLnFlush s = putStrLn s >> hFlush stdout --- * a generic quiz session - -type QuestionsAndAnswers = [(String, String -> (Integer,String))] - -teachDialogue :: QuestionsAndAnswers -> String -> IO () -teachDialogue qas welc = do - putStrLn $ welc ++++ genericTeachWelcome - teach (0,0) qas - where - teach _ [] = do putStrLn "Sorry, ran out of problems" - teach (score,total) ((question,grade):quas) = do - putStr ("\n" ++ question ++ "\n> ") - answer <- getLine - if (answer == ".") then return () else do - let (result, feedback) = grade answer - score' = score + result - total' = total + 1 - putStr (feedback ++++ "Score" +++ show score' ++ "/" ++ show total') - if (total' > 9 && fromInteger score' / fromInteger total' >= 0.75) - then do putStrLn "\nCongratulations - you passed!" - else teach (score',total') quas - - genericTeachWelcome = - "The quiz is over when you have done at least 10 examples" ++++ - "with at least 75 % success." +++++ - "You can interrupt the quiz by entering a line consisting of a dot ('.').\n" - - -- * IO monad with error; adapted from state monad newtype IOE a = IOE (IO (Err a)) diff --git a/src/GF/Quiz.hs b/src/GF/Quiz.hs new file mode 100644 index 000000000..92969aa3c --- /dev/null +++ b/src/GF/Quiz.hs @@ -0,0 +1,98 @@ +---------------------------------------------------------------------- +-- | +-- 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 GF.Quiz ( + mkQuiz, + translationList, + morphologyList + ) where + +import PGF +import PGF.ShowLinearize + +import GF.Data.Operations +import GF.Infra.UseIO +import GF.Text.Coding + +import System.Random + +import Data.List (nub) + +-- translation and morphology quiz. AR 10/5/2000 -- 12/4/2002 + +-- generic quiz function + +mkQuiz :: String -> String -> [(String,[String])] -> IO () +mkQuiz cod msg tts = do + let qas = [ (q, mkAnswer cod as) | (q,as) <- tts] + teachDialogue qas msg + +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 + +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] -> String -> (Integer, String) +mkAnswer cod as s = + if (elem (norm s) as) + then (1,"Yes.") + else (0,"No, not" +++ s ++ ", but" ++++ enc (unlines as)) + where + norm = unwords . words . decodeUnicode cod + enc = encodeUnicode cod + +norml = unwords . words + + +-- * a generic quiz session + +type QuestionsAndAnswers = [(String, String -> (Integer,String))] + +teachDialogue :: QuestionsAndAnswers -> String -> IO () +teachDialogue qas welc = do + putStrLn $ welc ++++ genericTeachWelcome + teach (0,0) qas + where + teach _ [] = do putStrLn "Sorry, ran out of problems" + teach (score,total) ((question,grade):quas) = do + putStr ("\n" ++ question ++ "\n> ") + answer <- getLine + if (answer == ".") then return () else do + let (result, feedback) = grade answer + score' = score + result + total' = total + 1 + putStr (feedback ++++ "Score" +++ show score' ++ "/" ++ show total') + if (total' > 9 && fromInteger score' / fromInteger total' >= 0.75) + then do putStrLn "\nCongratulations - you passed!" + else teach (score',total') quas + + genericTeachWelcome = + "The quiz is over when you have done at least 10 examples" ++++ + "with at least 75 % success." +++++ + "You can interrupt the quiz by entering a line consisting of a dot ('.').\n" -- cgit v1.2.3