module Work_List where

import Data.Char
import Test.QuickCheck



---------------------------------------------------------------------------
-- From last lecture

-- l1 +++ l2 (a.k.a. ++) appends l2 after l1
(+++) :: [a] -> [a] -> [a]
[]     +++ bs = []
(a:as) +++ bs = a : (as +++ bs)

-- property expressing that +++ is associative
prop_appendAssoc :: [Int] -> [Int] -> [Int] -> Bool
prop_appendAssoc as bs cs =
    as +++ (bs +++ cs) == (as +++ bs) +++ cs

-- value s returns the number represented by the string s as an integer
value :: String -> Int
value str = valueHelp (reverse str)

valueHelp :: String -> Int
valueHelp ""     = 0
valueHelp (d:ds) = digitToInt d + 10 * valueHelp ds
  -- Property of value and show

prop_value :: String -> Property
prop_value str =
    (s /= "" && head s /= '0') ==>
        show (value s) == s
  where
    s = [d | d <- str, isDigit d]

prop_value' :: String -> Property
prop_value' str
    | s /= "" && head s /= '0' =
        collect "interesting" (show (value s) == s)
    | otherwise = collect "uninteresting" True
  where
    s = [d | d <- str, isDigit d]

prop_value2 :: Int -> Property
prop_value2 n =
    n >= 0 ==> value (show n) == n


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

-- slow definition of "reverse", uses a quadratic number of steps
rev :: [a] -> [a]
rev []     = []
rev (a:as) = rev as ++ [a]

--   rev (1 : (2 : (3 : []))) -- [1,2,3]
-- = rev (2 : (3 : [])) ++ [1]
-- = (rev (3 : []) ++ [2]) ++ [1]
-- = ((rev [] ++ [3]) ++ [2]) ++ [1]
-- = (([] ++ [3]) ++ [2]) ++ [1]

-- faster definition of "reverse", uses a linear number of steps
rev2 :: [a] -> [a]
rev2 as = revHelp as []
  where
    revHelp []     korg = korg
    revHelp (a:as) korg = revHelp as (a:korg)

--   rev2 (1 : (2 : (3 : [])))
-- = revHelp (1 : (2 : (3 : []))) []
-- = revHelp (2 : (3 : []))) (1 : [])
-- = revHelp (3 : []) (2 : (1 : []))
-- = revHelp [] (3 : (2 : (1 : [])))
-- = (3 : (2 : (1 : [])))

-- Show evaluation of
--   rev  (1 : (2 : (3 : [])))
--   rev2 (1 : (2 : (3 : [])))

-- Note: The technique used in the fast reverse can be useful in lab 2 (e.g
-- shuffling a deck of cards).

-- properties of "reverse" that can be tested using QuickCheck

-- the length of a reversed lists should be the same as the original list
prop_ReverseLength :: [Int] -> Bool
prop_ReverseLength xs = length (reverse xs) == length xs

-- indexing in the original list should give the same result as indexing
-- "from the back" in the reversed list
prop_ReverseIndex :: [Int] -> Int -> Property
prop_ReverseIndex xs i =
  length xs > i && i >= 0 && length xs > 0 ==>
    (reverse xs !! i) == (xs !! (length xs - i - 1))

{-
  0   1   2   3   4  (5)
['a','b','c','d','e']

  0   1   2   3   4
['e','d','c','b','a']
-}

-- testing a property
--   A ==> B
-- will find 100 tests that make A true, and then test B

-- Bad idea: replace ==> with guards
  -- Use collect to see why



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

-- definition of "take"
tak :: Int -> [a] -> [a]
tak n []     = []
tak 0 _      = []
tak n (a:as) = a : tak (n-1) as

-- predicting the length of the result of take, for values that are
-- small: if we take n elements from a list with at least n elements, the
-- result has length n
prop_TakeLength :: Int -> [Int] -> Property
prop_TakeLength n xs =
  length xs >= n && n >= 0 ==>
    length (tak n xs) == n

prop_TakeLength' :: Int -> [Int] -> Property
prop_TakeLength' n xs
  | length xs >= n = n >= 0 ==> length (tak n xs) == n
  | otherwise      = n >= 0 ==> length (tak n xs) == length xs

-- predicting the length of the result of take, for values that are
-- small: if we take n elements from a list smaller than n elements, the
-- result has all the elements
prop_TakeLengthTooBig :: Int -> [Int] -> Property
prop_TakeLengthTooBig n xs = undefined

-- property stating the relationship between the functions "take" and "drop"
prop_TakeDrop :: Int -> [Int] -> Bool
prop_TakeDrop n xs = (take n xs ++ drop n xs) == xs

-- property stating that the result of maximum is greater >= all elements in the
-- list
prop_Maximum_Greater :: [Int] -> Bool
prop_Maximum_Greater xs = undefined

-- property stating that the result of maximum appears in the list
prop_Maximum_Element :: [Int] -> Property
prop_Maximum_Element xs = undefined

-- be careful, QuickCheck says the following is true
-- (because the type of xs defaults to [()])
prop_Reverse_Wierd xs =
  reverse xs == xs

-- proper test
prop_Reverse xs =
    reverse (reverse xs) == xs
  where
    _ = xs :: [Int]