import Numeric.Natural import qualified Data.List as List import Test.QuickCheck ----1 fib---- fib :: Int -> Int fib 0 = 0 fib 1 = 1 fib n = fib (n - 1) + fib (n - 2) ----efficient solution fib2 :: Integer -> Integer fib2 n | n == 0 = 0 | n == 1 = 1 | otherwise = fibhelper n 0 1 where fibhelper n n1 n2 | n == 1 = n2 | otherwise = fibhelper (n-1) n2 (n1+n2) -----another efficient solution fibFast :: Integer -> Integer fibFast n = fibList !! fromInteger n where fibList = 0 : 1 : zipWith (+) fibList (tail fibList) -----student's solution------- -----The idea is similar as fibFast. fib_naive 0 = 0 fib_naive 1 = 1 fib_naive x = fib_naive(x-2) + fib_naive(x-1) -- | gets the element with index x created by fib_list fib' x = fib_list 0 1 !! x where -- | recursivly expanding list of fibonacci numbers fib_list a b = a : fib_list b (a + b) prop_check_fibs x = (fib_naive (x `mod` 30) == fib' (x `mod` 30)) ----2 undup----- undupOne :: Eq a => a -> [a] -> [a] undupOne x [] = [] undupOne x (y:ys) | x == y = undupOne x ys | otherwise = [y] ++ (undupOne x ys) undup :: Eq a => [a] -> [a] undup [] = [] undup (x:xs) = [x] ++ undup (undupOne x xs) prop_undup :: [Int] -> Bool prop_undup xs = undup xs == List.nub xs -------student's solution------- undup' :: Eq a => [a] -> [a] undup' (x : xs) = x : undup' (filter (/= x) xs) ----3 smallest factor----- nlist :: Int -> [Int] nlist n | n <= 1 = [] | otherwise = nlist (n-1) ++ [n] isfactor :: Int -> Int -> Bool isfactor n m | (n `mod` m) * m > 0 = False | otherwise = True smalfactor :: Int -> Int smalfactor 1 = 1 smalfactor n = head (filter (isfactor n) (nlist n)) -----solution using comprehensive list----- smalfactor' :: Int -> Int smalfactor' n = head [ x | x <- [2..n], n `mod` x == 0 ] prop_smalfactor :: Int -> Bool prop_smalfactor n = smalfactor n == smalfactor' n ----{the result list is ordered. x <- [1..n] needs to declare first so that x is declared.} ----4 media library---- data Rating = Good | Bad deriving (Eq) type SongTitle =String type Artist = String type Duration = Int type AlbumTitle = String --type Track = (AlbumTitle, SongTitle, Artist, Duration) --type Album = [Track] type Rate = (User, Track, Rating) type Track = (SongTitle, Artist, Duration) type Album = (AlbumTitle, [Track]) --type MediaBib = (AlbumTitle, Track) type MediaBib = [(Album, [Rate])] type User = String trackinAlbum :: Track -> Album -> Bool trackinAlbum (st, n, d) (a, ((st', n', d'):ts)) = if n /= n' then False else if st == st' then True else trackinAlbum (st, n, d) (a, ts) trackinAlbum (st, n, d) _ = False addAlbum :: Track -> Album -> MediaBib -> MediaBib addAlbum (st, n, d) (a, ts) [] = if trackinAlbum (st, n, d) (a, ts) then [((a, ts), [])] else [((a, (st, n, d):ts), [])] addAlbum (st, n, d) (a, ts) (((a', ts'), rs):ms) = if a /= a' then addAlbum (st, n, d) (a, ts) ms else (if trackinAlbum (st, n, d) (a, ts) then ((a, ts), rs):ms else ((a, (st, n, d):ts), []):ms) --why is it fine without [] case? rateExit :: User -> Track -> [Rate] -> Bool rateExit u (st, n, d) [] = False rateExit u (st, n, d) ((u', (st', n', d'), r):rs) = if u == u' && st == st && n == n' then True else rateExit u (st, n, d) rs rateTrack :: User -> Track -> Rating -> MediaBib -> MediaBib rateTrack u (st, n, d) rate (((a, ts), rs):ms) = if trackinAlbum (st, n, d) (a, ts) then if rateExit u (st, n, d) rs then ((a, ts), rs):ms else ((a, ts), (u, (st, n, d), rate):rs):ms else rateTrack u (st, n, d) rate ms rateTrack u (st, n, d) rate _ = undefined ------duration of all the albums---- durationA :: [Track] -> Duration durationA [] = 0 durationA ((st, n, d):ts) = d + durationA ts albumDuration :: MediaBib -> [(AlbumTitle, Duration)] albumDuration [] = [] albumDuration (((a, ts), rs):ms) = (a, (durationA ts)):(albumDuration ms) -----50% good rate----- userGoodRate :: User -> [Track] -> [Rate] -> Int userGoodRate u ts ((u', t, r):[]) = if u /= u' then 0 else if r == Good then 1 else 0 userGoodRate u ts ((u', t, r):rs) = if u /= u' then userGoodRate u ts rs else if r == Good then 1 + userGoodRate u ts rs else userGoodRate u ts rs goodRate :: User -> MediaBib -> [AlbumTitle] goodRate u [] = [] goodRate u (((a, ts), rs):ms) = if (userGoodRate u ts rs) * 2 >= length ts then a:(goodRate u ms) else goodRate u ms -------Exercise 5 (Tic-Tac-Toe)-------- data Token = Nought | Cross deriving (Eq) --data Statu = InProgress | Won | Invalid -- deriving (Eq) data Grid = Empty | Grid Token deriving (Eq) type Row = [Grid] type Game = [Row] isNought :: Grid -> Bool isNought (Grid Nought) = True isNought _ = False isCross :: Grid -> Bool isCross (Grid Cross) = True isCross _ = False rowTokenN :: Grid -> Row -> Int rowTokenN (Grid Nought) r = length(filter isNought r) rowTokenN (Grid Cross) r = length(filter isCross r) rowTokenN _ _ = undefined ----the number of one token in a game gameTokenN :: Game -> Grid -> Int gameTokenN [] (Grid Nought) = 0 gameTokenN [] (Grid Cross) = 0 gameTokenN (r:rs) (Grid Nought) = foldr (+) 0 (map (rowTokenN (Grid Nought)) (r:rs)) gameTokenN (r:rs) (Grid Cross) = foldr (+) 0 (map (rowTokenN (Grid Cross)) (r:rs)) ----three same tokens in a row, a column or a diagonle wonToken :: Row -> Bool wonToken [] = undefined wonToken rs = foldr (&&) True (map isNought rs) || foldr (&&) True (map isCross rs) ---- invalid status when there is more than one won, either from one token or two tokens. won_invalid :: Game -> Bool won_invalid [[x1, x2, x3], [y1, y2, y3], [z1, z2, z3]] = (if wonToken [x1, x2, x3] then if wonToken [y1, y2, y3] then True else if wonToken [z1, z2, z3] then True else False else if wonToken [y1, y2, y3] then if wonToken [z1, z2, z3] then True else False else False) || (if wonToken [x1, y1, z1] then if wonToken [x2, y2, z2] then True else if wonToken [x3, y3, y3] then True else False else if wonToken [x2, y2, z2] then if wonToken [x3, y3, z3] then True else False else False) --won_invalid _ = undefined ----a game is a won if one of tokens satisfies wonToken and there is no more than one won. gameWon :: Game -> Bool gameWon [[x1, x2, x3], [y1, y2, y3], [z1, z2, z3]] = not (won_invalid [[x1, x2, x3], [y1, y2, y3], [z1, z2, z3]]) && (wonToken [x1, x2, x3] || wonToken [y1, y2, y3] || wonToken [z1, z2, z3] || wonToken [x1, y1, z1] || wonToken [x2, y2, z2] || wonToken [x3, y3, z3] || wonToken [x1, y2, z3] || wonToken [x3, y2, z1]) gameWon _ = undefined ----A game is invalid if ----(1)the number of one token in a game is at least 2 more than the other token, and ----(2)more than one won gameInvalid :: Game -> Bool gameInvalid g = if (abs(gameTokenN g (Grid Nought) - gameTokenN g (Grid Cross)) >= 2) || won_invalid g then True else False --gameInvalid _ = undefined ----Check whether a grid is empty. emptyGrid :: Grid -> Bool emptyGrid Empty = True emptyGrid _ = False ----Check whether there is am empty grid on the board isnotFull :: Game -> Bool isnotFull [] = True isnotFull (r1:rs) = (foldr (||) True (map emptyGrid r1)) || isnotFull rs ----a game is in progress, the game is not one of the following cases ----(1) the game is invalid ----(2) some player won ----(3) the game is in tie. ----The tie statu is described in a general way by a full board game/board, which covers ties and some won status. ----the won status is overlapped with (2). gameProgress :: Game -> Bool gameProgress g = if (gameInvalid g == False || gameWon g == False) && (isnotFull g) then True else False --gameProgress _ = undefined