----------------------------------------------------------------------
-- |
-- 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.Linearize
import GF.Data.Operations
--import GF.Infra.UseIO
--import GF.Infra.Option
--import PGF.Probabilistic

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])] -> IO ()
mkQuiz :: String -> [(String, [String])] -> IO ()
mkQuiz String
msg [(String, [String])]
tts = do
  let qas :: [(String, String -> (Integer, String))]
qas = [(String
q, [String] -> String -> (Integer, String)
mkAnswer [String]
as) | (String
q,[String]
as) <- [(String, [String])]
tts]
  [(String, String -> (Integer, String))] -> String -> IO ()
teachDialogue [(String, String -> (Integer, String))]
qas String
msg

translationList :: 
  Maybe Expr -> PGF -> Language -> Language -> Type -> Int -> IO [(String,[String])]
translationList :: Maybe Expr
-> PGF
-> Language
-> Language
-> Type
-> Int
-> IO [(String, [String])]
translationList Maybe Expr
mex PGF
pgf Language
ig Language
og Type
typ Int
number = do
  StdGen
gen <- IO StdGen
forall (m :: * -> *). MonadIO m => m StdGen
newStdGen
  let ts :: [Expr]
ts   = Int -> [Expr] -> [Expr]
forall a. Int -> [a] -> [a]
take Int
number ([Expr] -> [Expr]) -> [Expr] -> [Expr]
forall a b. (a -> b) -> a -> b
$ case Maybe Expr
mex of
                             Just Expr
ex -> StdGen -> PGF -> Expr -> [Expr]
forall g. RandomGen g => g -> PGF -> Expr -> [Expr]
generateRandomFrom StdGen
gen PGF
pgf Expr
ex
                             Maybe Expr
Nothing -> StdGen -> PGF -> Type -> [Expr]
forall g. RandomGen g => g -> PGF -> Type -> [Expr]
generateRandom     StdGen
gen PGF
pgf Type
typ
  [(String, [String])] -> IO [(String, [String])]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(String, [String])] -> IO [(String, [String])])
-> [(String, [String])] -> IO [(String, [String])]
forall a b. (a -> b) -> a -> b
$ (Expr -> (String, [String])) -> [Expr] -> [(String, [String])]
forall a b. (a -> b) -> [a] -> [b]
map Expr -> (String, [String])
mkOne ([Expr] -> [(String, [String])]) -> [Expr] -> [(String, [String])]
forall a b. (a -> b) -> a -> b
$ [Expr]
ts
 where
   mkOne :: Expr -> (String, [String])
mkOne Expr
t = (String -> String
norml (PGF -> Language -> Expr -> String
linearize PGF
pgf Language
ig Expr
t), 
              (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
norml ((Expr -> [String]) -> [Expr] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Expr -> [String]
lins (Expr -> [Expr]
homonyms Expr
t)))
   homonyms :: Expr -> [Expr]
homonyms = PGF -> Language -> Type -> String -> [Expr]
parse PGF
pgf Language
ig Type
typ (String -> [Expr]) -> (Expr -> String) -> Expr -> [Expr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGF -> Language -> Expr -> String
linearize PGF
pgf Language
ig
   lins :: Expr -> [String]
lins = [String] -> [String]
forall a. Eq a => [a] -> [a]
nub ([String] -> [String]) -> (Expr -> [String]) -> Expr -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(String, String)] -> [String])
-> [[(String, String)]] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> String
forall a b. (a, b) -> b
snd) ([[(String, String)]] -> [String])
-> (Expr -> [[(String, String)]]) -> Expr -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGF -> Language -> Expr -> [[(String, String)]]
tabularLinearizes PGF
pgf Language
og

morphologyList :: 
  Maybe Expr -> PGF -> Language -> Type -> Int -> IO [(String,[String])]
morphologyList :: Maybe Expr
-> PGF -> Language -> Type -> Int -> IO [(String, [String])]
morphologyList Maybe Expr
mex PGF
pgf Language
ig Type
typ Int
number = do
  StdGen
gen <- IO StdGen
forall (m :: * -> *). MonadIO m => m StdGen
newStdGen
  let ts :: [Expr]
ts   = Int -> [Expr] -> [Expr]
forall a. Int -> [a] -> [a]
take (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 Int
number) ([Expr] -> [Expr]) -> [Expr] -> [Expr]
forall a b. (a -> b) -> a -> b
$ case Maybe Expr
mex of
                                     Just Expr
ex -> StdGen -> PGF -> Expr -> [Expr]
forall g. RandomGen g => g -> PGF -> Expr -> [Expr]
generateRandomFrom StdGen
gen PGF
pgf Expr
ex
                                     Maybe Expr
Nothing -> StdGen -> PGF -> Type -> [Expr]
forall g. RandomGen g => g -> PGF -> Type -> [Expr]
generateRandom     StdGen
gen PGF
pgf Type
typ
  let ss :: [[[(String, String)]]]
ss    = (Expr -> [[(String, String)]]) -> [Expr] -> [[[(String, String)]]]
forall a b. (a -> b) -> [a] -> [b]
map (PGF -> Language -> Expr -> [[(String, String)]]
tabularLinearizes PGF
pgf Language
ig) [Expr]
ts
  let size :: Int
size  = [(String, String)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([[(String, String)]] -> [(String, String)]
forall a. [a] -> a
head ([[[(String, String)]]] -> [[(String, String)]]
forall a. [a] -> a
head [[[(String, String)]]]
ss))
  let forms :: [Int]
forms = Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
number ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> StdGen -> [Int]
forall a g. (Random a, RandomGen g) => (a, a) -> g -> [a]
randomRs (Int
0,Int
sizeInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) StdGen
gen
  [(String, [String])] -> IO [(String, [String])]
forall (m :: * -> *) a. Monad m => a -> m a
return [((String, String) -> String
forall a b. (a, b) -> b
snd ([(String, String)] -> (String, String)
forall a. [a] -> a
head [(String, String)]
pws0) String -> String -> String
+++ (String, String) -> String
forall a b. (a, b) -> a
fst ([(String, String)]
pws0 [(String, String)] -> Int -> (String, String)
forall a. [a] -> Int -> a
!! Int
i), [String]
ws) | 
           (pwss :: [[(String, String)]]
pwss@([(String, String)]
pws0:[[(String, String)]]
_),Int
i) <- [[[(String, String)]]] -> [Int] -> [([[(String, String)]], Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [[[(String, String)]]]
ss [Int]
forms, let ws :: [String]
ws = ([(String, String)] -> String) -> [[(String, String)]] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\[(String, String)]
pws -> (String, String) -> String
forall a b. (a, b) -> b
snd ([(String, String)]
pws [(String, String)] -> Int -> (String, String)
forall a. [a] -> Int -> a
!! Int
i)) [[(String, String)]]
pwss]

-- | compare answer to the list of right answers, increase score and give feedback 
mkAnswer :: [String] -> String -> (Integer, String) 
mkAnswer :: [String] -> String -> (Integer, String)
mkAnswer [String]
as String
s = 
  if (String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (String -> String
norm String
s) [String]
as) 
     then (Integer
1,String
"Yes.") 
     else (Integer
0,String
"No, not" String -> String -> String
+++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", but" String -> String -> String
++++ [String] -> String
unlines [String]
as)
 where
   norm :: String -> String
norm = [String] -> String
unwords ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words

norml :: String -> String
norml = [String] -> String
unwords ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words


-- * a generic quiz session

type QuestionsAndAnswers = [(String, String -> (Integer,String))]

teachDialogue :: QuestionsAndAnswers -> String -> IO ()
teachDialogue :: [(String, String -> (Integer, String))] -> String -> IO ()
teachDialogue [(String, String -> (Integer, String))]
qas String
welc = do
  String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
welc String -> String -> String
++++ String
genericTeachWelcome
  (Integer, Integer)
-> [(String, String -> (Integer, String))] -> IO ()
teach (Integer
0,Integer
0) [(String, String -> (Integer, String))]
qas
 where 
    teach :: (Integer, Integer)
-> [(String, String -> (Integer, String))] -> IO ()
teach (Integer, Integer)
_ [] = do String -> IO ()
putStrLn String
"Sorry, ran out of problems"
    teach (Integer
score,Integer
total) ((String
question,String -> (Integer, String)
grade):[(String, String -> (Integer, String))]
quas) = do
      String -> IO ()
putStr (String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
question String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n> ") 
      String
answer <- IO String
getLine
      if (String
answer String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
".") then () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return () else do
        let (Integer
result, String
feedback) = String -> (Integer, String)
grade String
answer
            score' :: Integer
score' = Integer
score Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
result 
            total' :: Integer
total' = Integer
total Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1
        String -> IO ()
putStr (String
feedback String -> String -> String
++++ String
"Score" String -> String -> String
+++ Integer -> String
forall a. Show a => a -> String
show Integer
score' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
total')
        if (Integer
total' Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
9 Bool -> Bool -> Bool
&& Integer -> Double
forall a. Num a => Integer -> a
fromInteger Integer
score' Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Integer -> Double
forall a. Num a => Integer -> a
fromInteger Integer
total' Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
0.75)
           then do String -> IO ()
putStrLn String
"\nCongratulations - you passed!"
           else (Integer, Integer)
-> [(String, String -> (Integer, String))] -> IO ()
teach (Integer
score',Integer
total') [(String, String -> (Integer, String))]
quas

    genericTeachWelcome :: String
genericTeachWelcome = 
      String
"The quiz is over when you have done at least 10 examples" String -> String -> String
++++
      String
"with at least 75 % success." String -> String -> String
+++++
      String
"You can interrupt the quiz by entering a line consisting of a dot ('.').\n"