module Sol_Exercise_3 where import Test.QuickCheck import Data.List import Data.Char {- Library DO NOT CHANGE -} type CentreFun = [Char] -> [Char] type Picture = [[Char]] printPicture :: Picture -> IO () printPicture [] = return () printPicture (xs : xss) = do putStrLn xs printPicture xss pic = [".##.", ".#.#", ".###", "####"] {- End Library -} {- G1 -} snoc :: [a] -> a -> [a] snoc [] y = [y] snoc (x : xs) y = x : snoc xs y member :: Eq a => a -> [a] -> Bool member _ [] = False member e (x : xs) = e == x || member e xs butlast :: [a] -> [a] butlast [] = [] butlast [_] = [] butlast (x : xs) = x : butlast xs {- G2 -} uniq :: Eq a => [a] -> [a] uniq (x:y:ys) = if x == y then uniq (y:ys) else x : uniq (y:ys) uniq xs = xs -- Alternativ: uniq' :: Eq a => [a] -> [a] uniq' [] = [] uniq' (x:xs) = f x xs where f x [] = [x] f x (y:ys) | x == y = f x ys | otherwise = x : f y ys uniqCount :: Eq a => [a] -> [(a, Integer)] uniqCount [] = [] uniqCount (x:xs) = f (x,1) xs where f p [] = [p] f (x,c) (y:ys) | x == y = f (x, c + 1) ys | otherwise = (x,c) : f (y, 1) ys {- G3 -} intersep :: a -> [a] -> [a] intersep sep (c : c' : cs) = c : sep : intersep sep (c' : cs) intersep _ cs = cs andList :: [[Char]] -> [Char] andList [] = "" andList [w] = w andList [w1, w2] = w1 ++ " and " ++ w2 andList [w1, w2, w3] = w1 ++ ", " ++ w2 ++ ", and " ++ w3 andList (w : ws) = w ++ ", " ++ andList ws {- G4 -} triangle :: [a] -> [(a, a)] triangle [] = [] triangle (x : xs) = [(x, x') | x' <- xs] ++ triangle xs {- QuickCheck properties -} prop_triangle_base = triangle ([] :: [Int]) == [] prop_triangle_one x = triangle [x] == [] prop_triangle_two x y = triangle [x, y] == [(x, y)] prop_triangle_length xs = length (triangle xs) == n * (n - 1) `div` 2 where n = length xs prop_triangle_distinct xs = distinct xs ==> distinct (triangle xs) where distinct ys = nub ys == ys prop_triangle_complete x xs y ys = (x, y) `elem` triangle (x : xs ++ y : ys) prop_triangle_sound1 x y xs = not ((x, y) `elem` triangle (delete x (nub xs))) && not ((y, x) `elem` triangle (delete x (nub xs))) prop_triangle_rec x xs = triangle (x : xs) == [(x, x') | x' <- xs] ++ triangle xs {- H1 -} simplifySpaces :: [Char] -> [Char] simplifySpaces s = [if isSpace x then ' ' else x | x <- normalize (trimEnd (trimStart s))] where trimStart [] = [] trimStart (x : xs) | isSpace x = trimStart xs | otherwise = x : xs trimEnd xs = reverse (trimStart (reverse xs)) normalize [] = [] normalize (x : y : xs) | isSpace x && isSpace y = normalize (y : xs) normalize (x : xs) = x : normalize xs simplifySpaces' = concat . intersperse " " . words {- H2 -} trim :: String -> String trim xs = (reverse . ltrim . reverse . ltrim) xs where ltrim [] = [] ltrim (x:xs) | isSpace x = ltrim xs | otherwise = x : xs lspace :: String -> String lspace [] = [] lspace (x:xs) | isSpace x = x : lspace xs | otherwise = [] rspace :: String -> String rspace = reverse . lspace . reverse prop_centre1 :: CentreFun -> [Char] -> Bool prop_centre1 centre xs = length (lines xs) == length (lines (centre xs)) prop_centre2 :: CentreFun -> [Char] -> Bool prop_centre2 centre xs = maximum lens == minimum lens where lens = map length (lines (centre xs)) prop_centre3 :: CentreFun -> [Char] -> Bool prop_centre3 centre xs = or [ line == trim line | line <- lines (centre xs)] prop_centre4 :: CentreFun -> [Char] -> Bool prop_centre4 centre xs = and [trim i == trim o | (i,o) <- zip (lines xs) (lines (centre xs))] prop_centre5 :: CentreFun -> [Char] -> Bool prop_centre5 centre xs = and [ and [ s == ' ' | s <- lspace ls ++ rspace ls] | ls <- lines (centre xs)] where ls = lines (centre xs) prop_centre6 :: CentreFun -> [Char] -> Bool prop_centre6 centre xs = and [abs (length (lspace line) - length (rspace line)) <= 1 | line <- lines (centre xs)] prop_centre7 :: CentreFun -> [Char] -> Bool prop_centre7 centre xs = True prop_centre8 :: CentreFun -> [Char] -> Bool prop_centre8 centre xs = True prop_centre9 :: CentreFun -> [Char] -> Bool prop_centre9 centre xs = True prop_centre10 :: CentreFun -> [Char] -> Bool prop_centre10 centre xs = True {- H3 -} rotateCCW :: Picture -> Picture rotateCCW [] = [] rotateCCW xss | all null xss = [] | otherwise = rotateCCW [safeTail xs | xs <- xss] ++ [[safeHead xs | xs <- xss]] where safeHead xs = if null xs then '.' else head xs safeTail xs = if null xs then [] else tail xs {- H4 -} {-WETT-} encode :: String -> String -> String encode key cleartext = [key !! (ord c - ord 'a') | c <- cleartext] decode :: String -> String -> String decode key cryptotext = [chr (ord 'a' + a) | c <- cryptotext, a <- elemIndices c key] {-TTEW-}