{- CSci 450/503 Fall 2014 Examination #1 H. Conrad Cunningham 28 Sep 2014 -- first version 04 Oct 2014 -- added more testing 123456789012345678901234567890123456789012345678901234567890123456789012 Do :set +t -} module Exam01 where -- Problem 1 p1i = let f ((v:w):(x:y):z) = ("v = " ++ show v ++ ", w = " ++ show w ++ ", x = " ++ show x ++ ", y = " ++ show y ++ ", z = " ++ show z) in f [[1,2,3], [4], []] -- Problem 2 -- Do " :type p2a " ... p2a = (:) p2b = tail p2c = map p2d x = (flip (:)) x -- Problem 3 -- 3(a) has a syntax ERROR because 't':[] or "t`q" is needed -- at end. -- "rst" == 'r':'s':'t' p3b = "rst" == ['r','s','t'] p3c = "rst" == 'r':"st" p3d = map (+1) [1,0,-1,3] p3e = [ n | (n,c) <- zip [1..] "hello_world", c == 'o' ] p3f = map reverse ["ABLE", "WAS", "I", "ERE", "I", "SAW", "ELBA", "!"] -- Problem 4 xsss = [ ["born"], ["to", "be"] , ["wild"] ] p4a = "Ace the exam" p4b = length xsss p4c = tail xsss p4d = [ x | xss <- xsss, xs <- xss, x <- (xs ++ "#") ] p4e = sum [ length xs | xss <- xsss, xs <- xss ] p4f = (head . tail . head . tail) xsss {- Problem 7 Remember from mathematics that a set is an unordered collection of zero or more distinct objects. Suppose we represent a set "type" in Haskell as a list of elements arranged in increasing order. We call this the canonical representation for the sets. For example, we can represent the set of integers {10,7,24} with the list [7,10,24]. Furthermore, suppose we use the following polymorphic type alias f or sets: type Set a = [a] Implement the following functions. Give the type signatures and the defining equations. Functions earlier in the list may be used to implement those later in the list. -} {- 7(a) Insertion Sort An insertion sort of a list can be implemented by inserting the head element of a list into the sorted tail as follows: isort :: Ord a => [a] -> [a] isort [] = [] isort (x:xs) = ins x (isort xs) Define the (directly) recursive function ins that takes an element and an ascending list (i.e, arranged in nondecreasing order) and returns the list with the new element inserted at an appropriate position to maintain the ascending order. (Do not use the standard library function insert. For example, ins 6 [2,3,8]} returns [2,3,6,8]} and ins 3 [2,3,8]} returns [2,3,3,8]. -} type Set a = [a] isort :: Ord a => [a] -> [a] isort [] = [] isort (x:xs) = ins x (isort xs) -- solution 7(a) ins :: Ord a => a -> [a] -> [a] ins x [] = [x] ins x zs@(y:ys) | x <= y = x : zs | otherwise = y : ins x ys p7a1 = ins 0 ([] :: [Int]) p7a2 = ins 0 [1..10] p7a3 = ins 11 [1..10] p7a4 = ins 5 ([1..4] ++ [6..10]) p7a5 = isort [10..1] p7a6 = isort ([] :: [Int]) p7a7 = isort [1..10] {- 7(b) Remove Adjacent Duplicates Write a (directly) recursive function remdups that takes a list and returns the list with adjacent duplicates removed. Do not use the standard library function nub. For example, remdups [1,2,2,2,4] returns [1,2,4]. -} remdups :: Eq a => [a] -> [a] remdups (x:xs@(y:_)) | x == y = remdups xs | otherwise = x : remdups xs remdups xs = xs p7b1 = remdups ([] :: [Int]) p7b2 = remdups [1] p7b3 = remdups [1,1] p7b4 = remdups [1,1,1,2,2,3,4,4] {- 7(c) Write a function \texttt{makeSet} that takes an arbitrary list o felements and returns the set (i.e., Set) represented in the canonical form as described above. For example, makeSet [1,2,2,2,1,3] returns [1,2,3]. -} makeset :: Ord a => [a] -> [a] makeset = remdups . isort p7c1 = makeset ([] :: [Int]) p7c2 = makeset [1] p7c3 = makeset [5,4,3,2,7,-1] test_all = do putStrLn "#1" putStrLn (show p1i) putStrLn "#3" putStrLn "ERROR" putStrLn (show p3b) putStrLn (show p3c) putStrLn (show p3d) putStrLn (show p3e) putStrLn (show p3f) putStrLn "#4" putStrLn (show p4a) putStrLn (show p4b) putStrLn (show p4c) putStrLn (show p4d) putStrLn (show p4e) putStrLn (show p4f) putStrLn "#7(a)" putStrLn (show p7a1) putStrLn (show p7a2) putStrLn (show p7a3) putStrLn (show p7a4) putStrLn (show p7a5) putStrLn (show p7a6) putStrLn (show p7a7) putStrLn "#7(b)" putStrLn (show p7b1) putStrLn (show p7b2) putStrLn (show p7b3) putStrLn (show p7b4) putStrLn (show p7a5) putStrLn (show p7a6) putStrLn (show p7a7) putStrLn "#7(c)" putStrLn (show p7c1) putStrLn (show p7c2) putStrLn (show p7c3) -- Set union -- removed -- union with O(n) steps where n = length xs + length ys union :: Ord a => Set a -> Set a -> Set a union [] ys = ys union xs [] = xs union xs@(x:xs') ys@(y:ys') | x < y = x : union xs' ys | x == y = x : union xs' ys' | otherwise = y : union xs ys' -- union with O(n^2) steps where n = length xs + length ys union' :: Ord a => Set a -> Set a -> Set a union' xs ys = makeset (xs ++ ys) -- Set intersection -- removed intersect :: Ord a => Set a -> Set a -> Set a intersect xs@(x:xs') ys@(y:ys') | x == y = x : intersect xs' ys' -- assume unique values | x < y = intersect xs' ys | otherwise = intersect xs ys' intersect _ _ = [] -- Generalized insert -- removed insG :: (a -> a -> Bool) -> a -> [a] -> [a] insG c x [] = [x] insG c x zs@(y:ys) | c x y = x : zs | otherwise = y : insG c x ys ins' :: Ord a => a -> [a] -> [a] ins' x xs = insG (<=) x xs isort' :: Ord a => [a] -> [a] isort' [] = [] isort' (x:xs) = ins x (isort' xs) -- Set membership member :: Eq a => a -> Set a -> Bool member x s = elem x s -- Set relative complement (first argument minus second) complement :: Ord a => Set a -> Set a -> Set a complement [] _ = [] complement xs [] = xs complement xs@(x:xs') ys@(y:ys') | x < y = x : complement xs' ys | x == y = complement xs' ys' -- assumes no duplicate values | otherwise = complement xs ys' -- Generalized set operation (based on the gmerge function -- from Notes) setop :: Ord a => Set a -> -- e1 (Set a -> Set a) -> -- e2 (Set a -> Set a) -> -- e3 (a -> a -> Set a) -> -- f4 (a -> a -> Set a) -> -- f5 (a -> a -> Set a) -> -- f6 (Set a -> Set a) -> -- g4 (Set a -> Set a) -> -- g5 (Set a -> Set a) -> -- g6 (Set a -> Set a) -> -- h4 (Set a -> Set a) -> -- h5 (Set a -> Set a) -> -- h6 Set a -> Set a -> Set a setop e1 e2 e3 f4 f5 f6 g4 g5 g6 h4 h5 h6 = setop' where setop' [] [] = e1 setop' [] bs@(y:ys) = e2 bs setop' as@(x:xs) [] = e3 as setop' as@(x:xs) bs@(y:ys) | x < y = f4 x y ++ setop' (g4 as) (h4 bs) | x == y = f5 x y ++ setop' (g5 as) (h5 bs) | otherwise = f6 x y ++ setop' (g6 as) (h6 bs) union'' :: Ord a => Set a -> Set a -> Set a union'' = setop [] id id -- e1, e2, e3 (const . (:[])) -- f4 (const . (:[])) -- f5 (flip (const . (:[]))) -- f6 tail tail id -- g4, g5, g6 id tail tail -- h4, h5, h6