import Test.QuickCheck
import Text.Show.Functions

import Data.Char
import Data.Maybe
import Data.List

---------------------------------------------------------------------
-- 0. Exercises from the Book

length' :: [a] -> Int
length' xs = sum (map (\x -> 1) xs)

--

addUp  ns = filter (>1) (map (+1) ns)
addUp' ns = map (+1) (filter (>0) ns)

prop_AddUp ns = addUp' ns == addUp (ns :: [Int])

--

iter :: Int -> (a -> a) -> (a -> a)
iter 0 f = id
iter n f = f . iter (n-1) f

{-
-- alternatively:
iter :: Int -> (a -> a) -> (a -> a)
iter 0 f x = x
iter n f x = f (iter (n-1) f x)
-}

--

mystery xs = foldr (++) [] (map sing xs)
 where
  sing x = [x]

prop_Mystery xs = mystery xs == (xs :: [Int])

--

dropUntil :: (a -> Bool) -> [a] -> [a]
dropUntil p []                 = []
dropUntil p (x:xs) | p x       = x:xs
                   | otherwise = dropUntil p xs

prop_DropUntil p xs =
  dropUntil p xs == dropWhile (not . p) (xs :: [Int])

--

getUntil p = takeWhile (not . p)

--

dropSpace = dropUntil (not . isSpace)

--takeWhile p = getUntil (not . p)

--

lines' [] = []
lines' xs = getUntil (=='\n') xs : lines' (drop 1 (dropUntil (=='\n') xs))


prop_Lines xs = lines' xs == lines xs

-- 10

{-
(id . f)  is the same as f, because the result of f is fed to the
          identity function id, and thus not changed
(id :: Bool -> Bool)

(f . id)  is the same as f, because the argument of f is fed to the
          identity function id, and thus not changed
(id :: Int -> Int)

id f      is the same as f, because applying id to something does not
          change it
(id :: (Int -> Bool) -> (Int -> Bool))
-}

--

composeList :: [a -> a] -> (a -> a)
composeList = foldr (.) id

{-
-- alternatively
composeList :: [a -> a] -> (a -> a)
composeList []     = id
composeList (f:fs) = f . composeList fs
-}

--

prop_IterN x y =
  x >= 0 && y >= 0 ==>
    f1 x y == f2 x y
 where
  f1 = (\n -> iter n succ) :: Int -> Int -> Int
  f2 = (+)

--

{-
\x y -> f y x
-}

--

flip' :: (a -> b -> c) -> (b -> a -> c)
flip' f = \x y -> f y x


---------------------------------------------------------------------
-- 1. List Comprehensions and Higher-order functions

prop_A1  xs    = map (+1) xs                                       == [ x+1 | x <- xs :: [Int] ]
prop_A2  xs ys = concat (map (\x -> map (\y -> x+y) ys) xs)        == [ x+y | x <- xs, y <- ys :: [Int] ]
prop_A3  xs    = map (+2) (filter (>3) xs)                         == [ x+2 | x <- xs :: [Int], x > 3 ]
prop_A4  xys   = map (\(x,_) -> x+3) xys                           == [ x+3 | (x,_) <- xys :: [(Int,Int)] ]
prop_A4' xys   = map ((+3) . fst) xys                              == [ x+3 | (x,_) <- xys :: [(Int,Int)] ]
prop_A5  xys   = map ((+4) . fst) (filter (\(x,y) -> x+y < 5) xys) == [ x+4 | (x,y) <- xys :: [(Int,Int)], x+y < 5 ]
prop_A6  mxs   = map (\(Just x) -> x+5) (filter isJust mxs)        == [ x+5 | Just x <- mxs :: [Maybe Int] ] 

prop_B1  xs    = [ x+3 | x <- xs ]               == map (+3) (xs :: [Int])
prop_B2  xs    = [ x | x <- xs, x > 7 ]          == filter (>7) (xs :: [Int])
prop_B3  xs ys = [ (x,y) | x <- xs, y <- ys ]    == concat (map (\x -> map (\y -> (x,y)) (ys :: [Int])) (xs :: [Int]))
prop_B4  xys   = [ x+y | (x,y) <- xys, x+y > 3 ] == filter (>3) (map (\(x,y) -> x+y) (xys :: [(Int,Int)])) 

{-
instance Arbitrary a => Arbitrary (Maybe a) where
  arbitrary =
    frequency
    [ (1, do return Nothing)
    , (5, do x <- arbitrary
             return (Just x))
    ]
-}

--------------------------------------------------------------------------
-- 2. Exercises on type Expr from the Lecture

{-
See file AnswersWeek5ExprVar.hs
-}


--------------------------------------------------------------------------
-- 3. Exercises on Propositional Logic

data Proposition = Var Name
                 | Proposition :&: Proposition
                 | Proposition :|: Proposition
                 | Not Proposition
 deriving ( Eq, Show )

type Name = String

---

vars :: Proposition -> [Name]
vars (Var x)   = [x]
vars (a :&: b) = vars a `union` vars b
vars (a :|: b) = vars a `union` vars b
vars (Not a)   = vars a

truthValue :: [(Name,Bool)] -> Proposition -> Bool
truthValue val (Var x)   = fromJust (lookup x val)
truthValue val (a :&: b) = truthValue val a && truthValue val b
truthValue val (a :|: b) = truthValue val a || truthValue val b
truthValue val (Not a)   = not (truthValue val a)

---

-- allVals xs enumerates all possible valuations of the variables xs:
--    1. when xs = [], there is just one valuation
--    2. otherwise, we enumerate all possible valuations for the rest
--       of the variables, plus all possible values of x
allVals :: [Name] -> [[(Name,Bool)]]
allVals []     = [[]]
allVals (x:xs) = [ (x,b):val
                 | val <- allVals xs
                 , b <- [False,True]
                 ]

tautology :: Proposition -> Bool
tautology a =
  and [ truthValue val a | val <- allVals (vars a) ]

-- an example
hamlet :: Proposition
hamlet = Var "to be" :|: Not (Var "to be")

---------------------------------------------------------------------
-- 4. Approximating 0-solutions to functions

solve :: (Double -> Double) -> (Double,Double) -> Double
solve f (x0,x1)
  | fx =? 0            = x
  | x0 == x1           = error "no solution found!"
  | fx0 > 0 || fx1 < 0 = error "interval does not contain 0!"
  | fx < 0             = solve f (x,x1)
  | fx > 0             = solve f (x0,x)
 where
  x   = (x0 + x1) / 2
  fx  = f x
  fx0 = f x0
  fx1 = f x1
  
  x =? y = abs (x-y) < 0.0000000001