-- Informatics 1 - Functional Programming
-- Tutorial 3
--
-- Week 5 - Due: 19-21 Oct.

import Data.Char
import Data.List
import Test.QuickCheck



-- 1. Map
-- a.
uppers :: String -> String
uppers = map toUpper

-- b.
doubles :: [Int] -> [Int]
doubles = map (*2)

-- c.
penceToPounds :: [Int] -> [Float]
penceToPounds = map ((/100) . fromIntegral)

-- d.
uppers' :: String -> String
uppers' xs = [toUpper x | x <- xs]

prop_uppers :: String -> Bool
prop_uppers xs = uppers xs == uppers' xs



-- 2. Filter
-- a.
alphas :: String -> String
alphas = filter isAlpha

-- b.
rmChar ::  Char -> String -> String
rmChar = filter . (/=)

-- c.
above :: Int -> [Int] -> [Int]
above = filter . flip (>)

-- d.
unequals :: [(Int,Int)] -> [(Int,Int)]
unequals = filter (\(x,y) -> x == y)

-- e.
rmCharComp :: Char -> String -> String
rmCharComp ch xs = [x | x <- xs, x /= ch]

prop_rmChar :: Char -> String -> Bool
prop_rmChar ch xs = rmChar ch xs == rmCharComp ch xs



-- 3. Comprehensions vs. map & filter
-- a.
upperChars :: String -> String
upperChars s = [toUpper c | c <- s, isAlpha c]

upperChars' :: String -> String
upperChars' = map toUpper . filter isAlpha

prop_upperChars :: String -> Bool
prop_upperChars s = upperChars s == upperChars' s

-- b.
largeDoubles :: [Int] -> [Int]
largeDoubles xs = [2 * x | x <- xs, x > 3]

largeDoubles' :: [Int] -> [Int]
largeDoubles' = map (*2) . filter (>3)

prop_largeDoubles :: [Int] -> Bool
prop_largeDoubles xs = largeDoubles xs == largeDoubles' xs

-- c.
reverseEven :: [String] -> [String]
reverseEven strs = [reverse s | s <- strs, even (length s)]

reverseEven' :: [String] -> [String]
reverseEven' = map reverse . filter (even . length)

prop_reverseEven :: [String] -> Bool
prop_reverseEven strs = reverseEven strs == reverseEven' strs



-- 4. Foldr
-- a.
productRec :: [Int] -> Int
productRec []     = 1
productRec (x:xs) = x * productRec xs

productFold :: [Int] -> Int
productFold = foldr (*) 1

prop_product :: [Int] -> Bool
prop_product xs = productRec xs == productFold xs

-- b.
andRec :: [Bool] -> Bool
andRec [] = True
andRec (x:xs) | x == True = andRec xs
              | otherwise = False

andFold :: [Bool] -> Bool
andFold = foldr (&&) True

prop_and :: [Bool] -> Bool
prop_and xs = andRec xs == andFold xs

-- c.
concatRec :: [[a]] -> [a]
concatRec [] = []
concatRec (x:xs) = x ++ concatRec xs

concatFold :: [[a]] -> [a]
concatFold = foldr (++) []

prop_concat :: [String] -> Bool
prop_concat strs = concatRec strs == concatFold strs

-- d.
rmCharsRec :: String -> String -> String
rmCharsRec [] ys = ys
rmCharsRec (x:xs) ys = rmCharsRec xs $ rmChar x ys

rmCharsFold :: String -> String -> String
rmCharsFold = flip (foldr rmChar)

prop_rmChars :: String -> String -> Bool
prop_rmChars chars str = rmCharsRec chars str == rmCharsFold chars str



type Matrix = [[Int]]


-- 5
-- a.
uniform :: [Int] -> Bool
uniform [] = True
uniform (x:xs) = all (==x) xs

all' :: (a -> Bool) -> [a] -> Bool
all' f = foldr (&&) True . map f

uniform' :: [Int]  -> Bool
uniform' [] = True
uniform' (x:xs) = all' (==x) xs

prop_uniform :: [Int] -> Bool
prop_uniform xs = uniform xs == uniform' xs

-- b.
valid :: Matrix -> Bool
valid (x:xs) = all' (\a -> length a == length x) xs

-- 6.

-- a: 18, converts a curried function into a function on pairs
-- b.
zipWith'' :: (a -> b -> c) -> [a] -> [b] -> [c]
zipWith'' f xs ys = [f x y | (x,y) <- zip xs ys]
-- c.
zipWith' :: (a -> b -> c) -> [a] -> [b] -> [c]
zipWith' f xs ys = map (uncurry f) $ zip xs ys

-- 7.
plusM :: Matrix -> Matrix -> Matrix
plusM = zipWith (zipWith (+))

-- 8. -- STUFF FROM HERE ON IS BAD
timesM :: Matrix -> Matrix -> Matrix
timesM a b | validIn a b = multiplyM a (transpose' b)
           | otherwise = error "Invalid input"

validIn :: Matrix -> Matrix -> Bool
validIn xs ys | valid xs && valid ys = length (head xs) == length ys
              | otherwise = error "Matrices are not valid!"

multiplyM :: Matrix -> Matrix -> Matrix
multiplyM [] _ = []
multiplyM (x:xs) ys = foldr (\y acc -> dotProd x y : acc) [] ys : multiplyM xs ys

dotProd :: [Int] -> [Int] -> Int
dotProd = (sum .) . zipWith (*)

transpose' :: [[a]] -> [[a]]
transpose' [] = []
transpose' xs = (foldr (\x acc -> (head x) : acc) [] xs) : transpose' [tail z | z <- xs, length z > 1]





-- Optional material
-- 9.

isNN :: Matrix -> Bool
isNN xs = length (head xs) == length xs

invertM :: Matrix -> [[Rational]]
invertM x | isNN x = rationalM x
          | otherwise = error "Only n*n matrices have inverses!!!"

rationalM :: Matrix -> [[Rational]]
rationalM = map (map realToFrac)

det :: [[Rational]] -> [[Rational]]
det xss | length xss == 2 = undefined
        | otherwise = undefined

removeIndexRow :: Int -> [Rational] -> [Rational]
removeIndexRow i xs = take i xs ++ drop (i + 1) xs