module AnswersExam where

import Test.QuickCheck
import Data.Char
import Data.List
import Data.Maybe
import Text.Show.Functions

------------------------------------------------------------------------------------
-- 1.

-- a.

(+.), (-.) :: Char -> Int -> Char
x +. k = chr ((ord x + k) `mod` 256)
x -. k = chr ((ord x - k + 256) `mod` 256)

-- b.

encryptC :: Int -> String -> String
encryptC k s = [ x +. k | x <- s ]

decryptC :: Int -> String -> String
decryptC k s = [ x -. k | x <- s ]

-- c.

prop_EncryptDecryptC k s =
  decryptC k (encryptC k s) == s

-- d.

instance Arbitrary Char where
  arbitrary =
    do x <- choose (0,255)
       return (chr x)

  coarbitrary = coarbitrary . ord

-- e.

common :: String -> String
common = take 10
       . map snd
       . reverse
       . sort
       . map (\cs -> (length cs, head cs))
       . group
       . sort

-- f.

crack :: FilePath -> String -> IO String
crack file message =
  do txt <- readFile file
     let cs      = common txt
         score s = length [ c | c <- s, c `elem` cs ]
     let k = head
           . map snd
           . reverse
           . sort
           $ [ (score s', k) | k <- [0..255], let s' = decryptC k message ]
     return (decryptC k message)

-- g.

encryptV :: [Int] -> String -> String
encryptV key s = [ x +. k | (x,k) <- s `zip` cycle key ]

decryptV :: [Int] -> String -> String
decryptV key s = [ x -. k | (x,k) <- s `zip` cycle key ]

prop_EncryptDecryptV key s =
  not (null key) ==>
    decryptV key (encryptV key s) == s

------------------------------------------------------------------------------------
-- 2.

someReplies =
  [ [(1,"very good"), (3,"bad"), (4,"okay")]
  , [(2,"good"), (3,"bad"), (4,"good"), (5,"difficult")]
  , [(4,"okay"), (5,"very difficult")]
  ]

-- a.

aReply :: Reply
aReply = [(1,"very good"), (3,"bad"), (4,"okay")]

type Reply = [(Int,String)]

someReplies :: [Reply]

-- b.

validReply :: Reply -> Bool
validReply ans = qs == nub qs
 where
  qs = [ q | (q,_) <- ans ]

-- c.

questions :: [Reply] -> [Int]
questions = sort . nub . map fst . concat

-- d.

answers :: Int -> [Reply] -> [String]
answers q rs = [ a | r <- rs, (q',a) <- r, q == q' ]

-- e.

summary :: [Reply] -> [(Int,[(Int,String)])]
summary rs =
  [ (q, counts (answers q rs))
  | q <- questions rs
  ]
 where
  counts = reverse
         . sort
         . map (\as -> (length as, head as))
         . group
         . sort

-- f.

summarize :: [Reply] -> IO ()
summarize rs =
  putStr $ unlines $
    [ "Q" ++ show q ++ ": "
   ++ unwords [ show (n*100 `div` tot) ++ "% " ++ s | (n,s) <- ans ]
    | (q,ans) <- summary rs
    , let tot = sum [ n | (n,_) <- ans ]
    ]

-- g.

mild :: [Reply] -> [Reply]
mild rs =
  [ [ (q, unwords [ w | w <- words a, w /= "very" ]) | (q,a) <- r ]
  | r <- rs
  ]

------------------------------------------------------------------------------------
-- 3.

type Var
  = String

data Prop
  = Var Var
  | And Prop Prop
  | Not Prop
  | Bool Bool
 deriving ( Eq, Show )

-- a.

orr, impl :: Prop -> Prop -> Prop
x `orr`  y = Not (Not x `And` Not y)
x `impl` y = Not x `orr` y

-- b.

vars :: Prop -> [Var]
vars (Var s)     = [s]
vars (p `And` q) = vars p `union` vars q
vars (Not p)     = vars p
vars (Bool b)    = []

-- c.

prop_VarsUnique p =
  nub xs == xs
 where
  xs = vars p

-- e.

instance Arbitrary Prop where
  arbitrary = sized arbProp
   where
    arbProp n =
      frequency
      [ (1, do s <- elements ["x","y","z"]
               return (Var s))
      , (1, do b <- arbitrary
               return (Bool b))
      , (n, do p <- arbProp (n `div` 2)         
               q <- arbProp (n `div` 2)         
               return (p `And` q))
      , (n, do p <- arbProp (n-1)         
               return (Not p))
      ]

-- f.

type Env = Var -> Bool

eval :: Env -> Prop -> Bool
eval env (Var v)     = env v
eval env (p `And` q) = eval env p && eval env q
eval env (Not p)     = not (eval env p)
eval env (Bool b)    = b

-- f'.

simplify :: Prop -> Prop
simplify (Not p)     = simp (Not (simplify p))
simplify (p `And` q) = simp (simplify p `And` simplify q)
simplify p           = p

simp :: Prop -> Prop
simp (Bool False `And` q) = Bool False
simp (p `And` Bool False) = Bool False
simp (Bool True `And` q)  = q
simp (p `And` Bool True)  = p
simp (Not (Not p))        = p
simp (Not (Bool b))       = Bool (not b)
simp p                    = p

-- g.

prop_SimplifySame env p =
  eval env p == eval env (simplify p)

prop_SimplifySimple p =
  not (simple p') || p' `elem` [ Bool False, Bool True ]
 where
  p' = simplify p

simple :: Prop -> Bool
simple (Bool _)    = True
simple (p `And` q) = simple p || simple q
simple (Not p)     = simple p
simple (Var s)     = False

-- h.

set :: Var -> Bool -> Env -> Env
set x b env y | x == y    = b
              | otherwise = env y

allEnvs :: [Var] -> [Env]
allEnvs []     = [ undefined ]
allEnvs (x:xs) = [ set x b env | env <- allEnvs xs, b <- [False,True] ]

valid :: Prop -> Bool
valid p = and [ eval env p' | env <- allEnvs (vars p') ]
 where
  p' = simplify p

-- i.

prop_Sound p env =
  valid p ==>
    eval env p

------------------------------------------------------------------------------------