import Text.Printf
import Test.QuickCheck


-- :set +s
-- module Programs
--   where 


reverseFast xs  = aux xs []
                  where  
                  aux [] ys     = ys
                  aux (x:xs) ys = aux xs (x:ys)


reverseNaive []     = []
reverseNaive (x:xs) = reverseNaive xs ++ [x]


performTestsReverse  = do 
      printf "Perfoming Tests:\n"
      printf "Testing property reverse(rerverse) = id:\n"
      quickCheck prop_reversereverse
      printf "Testing property reverse [x] = [x]:\n"
      quickCheck prop_reverseUnit
      printf "Testing property reverse (xs ++ ys) equals (reverse ys) ++ (reverse xs):\n"
      quickCheck prop_reverseAppend
      printf "Testing property reverseFast equals reverseNaive:\n"
      quickCheck prop_reverseFast
 
-- reversing twice a finite list, is the same as identity
prop_reversereverse xs = reverseNaive (reverseNaive xs) == id xs
                    where types = xs::[Int]

prop_reverseUnit x = reverseNaive [x] == id [x]
                   where types = x::Int

prop_reverseAppend xs ys = reverseNaive (xs ++ ys) == (reverseNaive ys) ++ (reverseNaive xs)
                     where types = (xs::[Char], ys::[Char])

-- reversing twice a finite list, is the same as identity
prop_reverseFast xs = reverseFast xs == reverseNaive xs
                 where types = xs::[Int]

-- Haskell Programs used in Informatik 1

palindrom l = (reverse l) == l

myLast [x] = x
myLast (x:x1:xs) = myLast (x1:xs)

allequal [] [] = True
allequal (x:xs) (y:ys)  = x==y && allequal xs ys


myadd a b | a == 0     = b
           | a > 0      = myadd (a-1) (b+1)
--          | otherwise  = error "Info1:myadd a < 0"
--           | a == (b+2) = 7
           | otherwise = myadd (a+1) (b-1)

mult a b | a == 0       = 0
         | a < 0        = (-mult (-a) b)
         | otherwise    = b + mult (a-1) b


-- performing tests for add:

performTestsMult = do
                 printf "Checking commutativity of mult:\n"
                 quickCheck prop_commutativity_mult
                 printf "Checking identity of mult:\n"
                 quickCheck prop_identity_mult
                 printf "Checking associativity of mult:\n"
                 quickCheck prop_associativity_mult




prop_commutativity_mult a b = 
      classify (a==0) "first argument == 0" $
      classify (a < -10) "first argument < -10" $
      classify (a >= -10 &&  a < 0) "-10 >= first argument < 0" $
      classify (a > 0) "first argument > 0" $
                    mult a b == mult b a
                    where types = (a::Integer, b::Integer)

prop_identity_mult b = mult 1 b == b
                        where types = b::Integer
prop_associativity_mult a b c = mult a (mult b c) == mult (mult a b) c
                        where types = (a::Integer, b::Integer, c::Integer)

multFast a b | a == 0       = 0
             | a < 0        = (-multFast (-a) b)           
             | mod a 2 == 0 = multFast (div a 2) (2*b)
             | otherwise    = b + multFast (a-1) b

prop_model_multFast a b = multFast a b == mult a b
                    where types = (a::Integer, b::Integer)

prop_commutativity_multFast a b = multFast a b == multFast b a
                        where types = (a::Int, b::Int)
prop_identity_multFast b = multFast 1 b == b
                        where types = b::Int
prop_associativity_multFast a b c = multFast a (multFast b c) == multFast (multFast a b) c
                        where types = (a::Int, b::Int)



prop_test1_myadd = myadd 0 4 == 4
prop_test2_myadd = myadd (-1) 1 == 0
prop_test3_myadd = myadd 1 (-1) == 0

prop_myadd a b  = 
           classify (a == 0) "a equals zero"$
           classify (a > 0) "a greater than zero"$
           classify (a < 0) "a smaller than zero"$
           myadd a b == a+b

prop_symmetry_myadd a = myadd (-a) a == 0


emptyList l = (l == [])
nonEmptyList l = (l /= [])

listLength l  | l == []   = 0
              | otherwise = 1 + listLength (tail l)


listLengthPattern []     = 0
listLengthPattern (x:xs) = 1+ listLengthPattern xs 


inc n = n + 1
dec n = n - 1

epsilon :: Double
epsilon = 0.000001

-- allEqual :: Int -> Int -> Int -> Bool
allEqual n1 n2 n3 = (n1 == n2) && (n1 == n3) 


maxInt :: Int -> Int -> Int
maxInt x y = if (x >= y) then x else y

prod m n | m == n   =	m
         | m > n    =	1
         | m < n    =	(prod m mid) * (prod (mid+1) n)
             	where
	        mid = (div (m + n) 2) 

closetoe = let epsilon = 0.00001
           in (1 + epsilon)**(1/epsilon)

squareGaussSumFast n = let 
                        gaussSum n1 = div (n1 * (n1+1))  2
                        n2 = gaussSum n
                        in n2 * n2 

bot = bot
 
0 `plus` b = b
a `plus` b = (a-1) `plus` (b+1)

add a b      | a == 0    = b
             | a > 0    = add (a-1) (b+1)

twice x = 2 * x


ggt a b | b == 0     = a
        | a == 0     = b
        | a >= b     = ggt (mod a b) b
        | otherwise  = ggt a (mod b a)


-- prop_comm_ggt :: Int -> Int -> Property
prop_comm_ggt a b = a > 0 && b > 0 ==> ggt a b == ggt b a

-- prop_div_ggt :: Int -> Int -> Property
prop_div_ggt a b = a > 0 && b > 0 ==>  mod a (ggt a b) == 0 && mod b (ggt a b) == 0

-- prop_biggest_ggt :: Int -> Int -> Property
prop_biggest_ggt a b = a > 0 && b > 0 ==> ggt (div a (ggt a b)) (div b (ggt a b)) == 1


ggtNaive a b = maxList [x | x <- [1..(min a b)], mod a x == 0, mod b x == 0]


-- prop_naive_ggt a b == ggt a b == 

-- prop_naive_ggt a b = (a > 0) && (b > 0) ==> ggt a b == ggtNaive a b 
prop_naive_ggt a b = (a>0) && (b>0) ==> ggt a b == ggtNaive a b 

sq n = n * n
x = 4
y = 3
z1 = div (sq (sq x))  (sq y)

square x                = x * x
distance x1 y1 x2 y2    = sqrt((square (x2 - x1)) + (square (y2 - y1)))

sign:: (Integral a, Integral b)  => a -> b
sign x | x > 0  = 1
       | x == 0 = 0
       | x < 0  = -1

myabs a | a >= 0    = a
        | otherwise = (-a)

-- sumList xs = foldr (+) 0 xs


fac 0 = 1
fac n = n * fac (n-1)

prop_fac n = (n>0) ==> fac n == foldr (*) 1 [1 .. n]


test n  = [n, 1, 2.5]

-- length1        :: [a] -> Integer
length1 []     = 0
length1 (a:as) = 1 + length1 as



append [] ys     = ys
append (x:xs) ys = x:(append xs ys)

foldr3 f e []     = e
foldr3 f e (x:xs) = x `f` foldr3 f e xs

m = [x^2 | x <- [0..20], mod x 2 == 0]

powset []     = [[]]
powset (x:xs) = append (powset xs) [x:y | y <- (powset xs)]

qsort    []  = []
qsort (x:xs) = qsort [b | b <- xs, b <= x] ++ [x] ++ qsort [b |b <- xs, b > x] 

ones = 1:ones

on = [1..]

nats = [0..]

elementAt n (x:xs) | n==0    = x
                   | n>0     = elementAt (n-1) xs


ones1 = [1,1..]
evens = [0,2..]
odds = [1,3..]

setOf1 xs = setOf1Aux xs []

setOf1Aux [] ys = ys
setOf1Aux (x:xs) ys | member x ys = setOf1Aux xs ys
setOf1Aux (x:xs) ys               = setOf1Aux xs (x:ys)


setOf2 xs = setOf2Aux xs []

setOf2Aux []     ys                = []
setOf2Aux (x:xs) ys | member x ys  = setOf2Aux xs ys
setOf2Aux (x:xs) ys                = x:setOf2Aux xs (x:ys) 

fib 0 = 0
fib 1 = 1
fib n = fib (n-1) + fib (n-2)

member x []              = False
member x (y:ys) | x == y = True
member x (y:ys)          = member x ys


hamming = 1: foldr merge2 [] [map (2*) hamming, map (3*) hamming, map (5*) hamming]

merge2 :: [Int] -> [Int] -> [Int] 
merge2 (x:xs) (y:ys) | x < y  = x:merge2 xs (y:ys)
                     | x == y = x:merge2 xs ys
                     | x > y  = y:(merge2 (x:xs) ys)



subList n m []           = []
sublist 0 m xs           = take m xs
sublist n m (x:xs) | n>0 = sublist (n-1) m xs


tt x = x + y
       where
       y = 5


fibFast 0 = 0
fibFast 1 = 1
fibFast n = sumList(sublist (n-2) 2 fibList)
            where
            fibList = (map (fibFast) [0..])

fibFast1 n = fibHelp 0 1 n
             where
	     fibHelp m1 m2 0      = m1
	     fibHelp m1 m2 m3     = fibHelp m2 (m1+m2) (m3-1)

newadd x y = x + y

newinc = newadd 1

myfst (x,y) = x
mysnd (x,y) = y

perfect n = sumList [ x | x <- [1.. (div n 2)], mod n x == 0] == n

sumList [] = 0
sumList (x:xs) = x + sumList xs

multiple5 x = ((mod x 5) == 0)

data Color       = Red | Green | Blue

colorEq Red Red      = True
colorEq Green Green  = True
colorEq Blue Blue    = True
colorEq _ _          = False

data Point       = P Int Int

data Tree a      = Nil | Node a (Tree a) (Tree a) 
	                   deriving Show

treeSum Nil            = 0
treeSum (Node x left right) = x + treeSum left + treeSum right  

inOrder Nil            = []
inOrder (Node x left right) = inOrder left ++ (x:inOrder right)

height Nil                 = 0
height (Node x left right) = 1 + max (height left) (height right)  

minTree (Node x l r) = minList (inOrder (Node x l r))


inBinTree x Nil                      = False
inBinTree x (Node y l r) | x == y    = True
                         | x < y     = inBinTree x l
                         | otherwise = inBinTree x r 

insertBinTree x Nil                      = (Node x Nil Nil)
insertBinTree x (Node y l r) | x == y    = (Node y l r)
                             | x < y     = (Node y (insertBinTree x l) r)
                             | otherwise = (Node y l (insertBinTree x r))

removeBinTree x Nil                      = Nil
removeBinTree x (Node y l r) | x < y     = Node y (removeBinTree x l) r
                             | x > y     = Node y l (removeBinTree x r)
                             | otherwise = removeRootNode (Node x l r)


removeRootNode (Node x Nil Nil) = Nil
removeRootNode (Node x (Node y l r) r1) = Node x2 t r1
               where (x2, t) = removeSymmetricPredecessor (Node y l r)
removeRootNode (Node x l1 (Node y l r)) = Node x2 l1 t
               where (x2, t) = removeSymmetricSuccessor (Node y l r)

removeSymmetricPredecessor (Node x l Nil) = (x, l)
removeSymmetricPredecessor (Node x l t) = (x1, (Node x l t1))
                           where (x1, t1) = removeSymmetricPredecessor t

removeSymmetricSuccessor (Node x Nil r) = (x, r)
removeSymmetricSuccessor (Node x t r) = (x1, (Node x t1 r))
                           where (x1, t1) = removeSymmetricSuccessor t

emptyTree Nil = True
emptyTree (Node _ _ _) = False


prop_emptyBinTree xs = emptyTree (removeListBinTree ys (binTreeOfList ys) )
                    where types = xs::[Integer]
                          ys = setOf1 xs
prop_sortedBinTree xs = length ys > 0 ==> inOrder (removeBinTree (head ys) (binTreeOfList (tail ys))) == qsort (tail ys)
                    where types = xs::[Integer]
                          ys = setOf1 xs


binTreeOfList [] = Nil
binTreeOfList (x:xs) = insertBinTree x (binTreeOfList xs)

removeListBinTree [] t = t
removeListBinTree (x:xs) t = removeListBinTree xs (removeBinTree x t)


test1 x y = (x1, y1)
            where
            (x1, y1) = (x+1, y+1) 


minList [x] = x
minList (x:y:xs) = minList ((min x y):xs)

maxList [x] = x
maxList (x:y:xs) = if (x >= y) then maxList (x:xs) else maxList (y:xs)


data Expr = Lit Int | Add Expr Expr | Sub Expr Expr

eval (Lit n) = n 
eval (Add x y) = eval x + eval y 
eval (Sub x y) = eval x - eval y

add10percent x = x*1.1


myfoldr f e [] 		= e
myfoldr f e (x:xs) 	= f x  (myfoldr f e xs)


end = reverse (['D','N','E'] ++ " " ++   qsort ['H','T','E']  )