diff options
Diffstat (limited to 'comp3141/hare/Hare.hs')
| -rw-r--r-- | comp3141/hare/Hare.hs | 406 |
1 files changed, 406 insertions, 0 deletions
diff --git a/comp3141/hare/Hare.hs b/comp3141/hare/Hare.hs new file mode 100644 index 0000000..8da7287 --- /dev/null +++ b/comp3141/hare/Hare.hs @@ -0,0 +1,406 @@ +module Hare where + +import Data.Traversable +import Data.Word +import Data.List +import Data.Maybe +import Control.Monad.State +import Test.QuickCheck +import GHC.Enum + +import RoverInterface +import RoverModel + +-- PART 1: FINDING WAYPOINTS + +data Path wp + = From wp + | GoTo (Path wp) wp + deriving (Eq) + +instance Show wp => Show (Path wp) where + show (From x) = "From " ++ show x + show (GoTo xs x) = show xs ++ " >:> " ++ show x + +-- Problem 1. Define a function `wf` that returns `True` +-- precisely if a given `Path` is well-formed according +-- to the rules set out in the specification. + +-- turn recrsive path into more managable list of waypoints +recurse_waypoints :: (Wp wp) => Path wp -> [wp] -> [wp] +recurse_waypoints (From wp) paths = paths ++ [wp] +recurse_waypoints (GoTo p wp) paths = paths ++ [wp] ++ (recurse_waypoints p paths) + +path_to_waypoints :: (Wp wp) => Path wp -> [wp] +path_to_waypoints p = recurse_waypoints p [] + +get_waypoint :: (Wp wp) => Path wp -> wp +get_waypoint (From wp) = wp +get_waypoint (GoTo p wp) = wp + +wf :: (Wp wp) => Path wp -> Bool +wf (From wp) = True -- a path From x is always well formed +wf (GoTo p wp) = + ((wp) `elem` (navigableFrom next)) && -- x is navigable from the endpoint of the path xs + (wf p) && -- the path xs is itself well formed + ((nub waypoints) == waypoints) where -- only unique waypoints + waypoints = (path_to_waypoints p) ++ [wp] + next = (get_waypoint p) + +-- Problem 2. Define a smart constructor `>:>` for `GoTo` +-- that returns `Nothing` if adding the given waypoint +-- to the given path would result in a non-well-formed path. +(>:>) :: (Wp wp) => Path wp -> wp -> Maybe (Path wp) +p >:> wp = if (wf new_path) then (Just new_path) else Nothing where + new_path = (GoTo p wp) + +-- Problem 3. Write a function `extendPath` which returns +-- all possible ways of extending the given `Path` by appending +-- a single additional waypoint. + +extendPath :: (Wp wp) => Path wp -> [Path wp] +extendPath p = catMaybes (map (\potential -> (p >:> potential)) potentials) where + potentials = navigableFrom (get_waypoint p) + +-- Problem 4. Implement a function `findPaths` which returns +-- all possible ways of extending the given `Path` (by appending +-- any number of additional waypoints) into a path that ends +-- at the given target waypoint. + +make_full_solution :: (Wp wp) => [Path wp] -> wp -> [Path wp] +make_full_solution paths target = + if ((length incomplete) <= 0) then solutions else solutions ++ (make_full_solution incomplete target) where + potential = concat (map (\p -> extendPath p) paths) + incomplete = filter (\p -> (head (path_to_waypoints p)) /= target) potential + solutions = filter (\p -> (head (path_to_waypoints p)) == target) potential + +findPaths :: (Wp wp) => Path wp -> wp -> [Path wp] +findPaths p target = if ((get_waypoint p) == target) then [p] else make_full_solution [p] target + +-- Efficiency mark 5: your solution should not spend time +-- expanding "useless" partial solutions. + + + + +--- PART 2: DISK MATTERS - ENCODE/DECODE + +-- The floppy disk drive has no means of tracking the +-- angular position of the spinning magnetic disk. +-- This means that in principle, reading/writing can +-- begin at any position within the track, and the +-- user has no control over where the reading/writing +-- starts from. + +-- For example, if you write [1,2,3,4,5,6] on a track of +-- capacity 6, it can happend that reading the track next +-- time will result in [5,6,1,2,3,4] or [2,3,4,5,6,1]. Note +-- however that the disk can spin only in one direction, so +-- you will never get a result like [6,5,4,3,2,1]. + +-- In this subproblem, you will come up with an encoding +-- scheme gets around the problem of the spinning disk. + +-- represents a list of bytes encoded using the scheme + +-- +data Encoded = Encoded [Word8] deriving (Show, Eq) + +unEncoded :: Encoded -> [Word8] +unEncoded (Encoded ws) = ws + +-- Problem 5. Implement a function `rotate` which simulates +-- the effect of the spinning disk by rotating the given +-- list to the left by the given number of entries. E.g. +-- rotate 3 (Encoded [1,2,3,4]) = Encoded [4,1,2,3] +-- Hint: for negative n, you get to choose the behavior. + +rotate_generic amount e = (b ++ a) where + (a, b) = splitAt (amount `rem` (max (length e) 1)) e + +rotate :: Int -> Encoded -> Encoded +rotate amount (Encoded e) = Encoded (rotate_generic amount e) + +-- Problem 6. Come up with an encoding scheme which gets +-- around the problem of the spinning disk. More formally, +-- implement a pair of functions, `encode` and `decode`, so +-- that: +-- +-- 1. Decoding an encoded list of bytes results in the +-- original list, i.e. decode (encode bs) = Just bs. +-- 2. Decoding is rotationally invariant, i.e. +-- decode . rotate n . encode = Just for any positive n. + +header :: [Word8] +header = [(fromIntegral 7), (fromIntegral 47)] + +terminator :: [Word8] +terminator = [(fromIntegral 97), (fromIntegral 178)] + +encoded_size :: [Word8] -> Int +encoded_size d = (2 * (length d)) + (length header) + (length terminator) + +-- encode = 50, 100, 150 + data * 2 + null terminator +encode :: [Word8] -> Encoded +encode d = Encoded (header ++ d ++ d ++ terminator) + + +decode :: Encoded -> Maybe [Word8] +decode (Encoded e) = + if ((maybe_terminator /= terminator) || (maybe_header /= header) || (first /= second)) + then decode (Encoded (rotate_generic 1 e)) + else Just first where + maybe_header = take 2 e + maybe_terminator = reverse (take 2 (reverse e)) + between = tail (tail (init (init e))) + (first, second) = splitAt ((length between) `div` 2) between + +-- Efficiency mark: encoding a list of bytes with length +-- no more than 16 should result in an encoded list of +-- length no more than 37. + + +-- PART 3: FILE SYSTEM HIERARCHY + +-- The rover's in-memory file system is organized into files and +-- directories. Each directory may contain other files and +-- directories inside it. Each file and directory is identified +-- by a unique `Word8`, its UID. + + +-- You can make the following assumptions about the file +-- system of the rover: +-- 1. The total size of all the files is no more than +-- 16kiB (16384 bytes). +-- 2. Every file is at most 3072 bytes long. +-- 3. There are at most 48 files and directories (but their +-- UIDs need not be in the range 0-47) altogether. + + +-- We have decided that one track on the disk will store the +-- contents of at most one file, i.e. that there will not be +-- any tracks which store multiple files. + +-- However, since floppy tracks store only 2048 bytes, and a +-- single file may be longer than 2048 bytes, we will have to +-- come up with a way of storing a single file across multiple +-- tracks. + +-- We will divide each file into a list of chunks, so that each +-- chunk is short enough to be stored in a single track. We will +-- assign each chunk its own unique track. + +-- To reassemble a file, we have to read and decode each of its +-- chunks from the disk in order, then concatenate the results. + +data Chunk = + Chunk TrackNo Encoded deriving (Show, Eq) + +-- Problem 7. Write a stateful function `chunks` which, +-- when given the contents of a file, divides it into +-- a list of `Chunk`s. + +-- The state `n` is a `TrackNo` between 0 and 255, +-- denoting the first track that is still available +-- to store data. E.g. if the state is 12, then +-- tracks 0-11 have already been used to store chunks, +-- but tracks 12-39 are still available. If all tracks +-- have been exhausted, signal the error by assiginng +-- the remaining chunks to track 40. + +split_amount = (2048 `div` 2) - 4 -- encoding is data * 2 + 4 + +tn_max :: TrackNo +tn_max = fromIntegral 40 + +split_into_n :: Int -> [Word8] -> [[Word8]] +split_into_n n d = if (length d) <= n then [d] else [split] ++ concat [(split_into_n n rest)] where + (split, rest) = splitAt n d + +chunks :: [Word8] -> State TrackNo [Chunk] +chunks d = do + tn <- get + put (min (tn + (fromIntegral (length cx))) tn_max) + return (map (\(Chunk tnn ee) -> Chunk (min (tn + tnn) tn_max) ee) cx) where + splits = split_into_n split_amount d + cx = map (\s -> Chunk (fromIntegral (fromJust (elemIndex s splits))) (encode s)) splits + +-- The `FSH t` data type represents a file system hierarchy +-- in which each file is annotated with data of type `t`. +-- For example, `FSH [Word8]` can be used to represent the +-- entire file system, where each file is annotated with its +-- contents (a list of bytes), while the type `FSH ()` can +-- be used to represent just the hierarchical relationships +-- between the files and directories (i.e. which contains +-- which), but without any of the file data. + +-- Problem 8. Write a lawful Functor instance for the FSH +-- type. + +instance Functor FSH where + fmap f (File uid a) = (File uid (f a)) + fmap f (Dir uid arr) = (Dir uid (map (fmap f) arr)) + +--instance Traversable FSH where +-- traverse f (File uid elem) = File uid <$> f elem +-- traverse f (Dir uid arr) = do +-- fx <- fmap (traverse f) arr +-- return $ Dir uid fx + +--instance Traversable FSH where +-- traverse f (File uid elem) = File <$> uid <*> f elem +-- traverse f (Dir uid arr) = Dir <$> uid <*> (map (traverse f) arr) + +--instance Traversable FSH where +-- traverse f (File uid elem) = File <$> uid <*> f elem +-- traverse f (Dir uid arr) = Dir <$> uid <*> (map (\x -> traverse f x) arr) + +--instance Traversable FSH where +-- traverse f (File uid a) = (File uid (f a)) +-- traverse f (Dir uid arr) = (Dir uid (map (traverse f) arr)) + +-- parseElems :: Traversal' Term Term + + + --traverse f (Dir uid arr) = (Dir (uid) (map (\x -> traverse f x) arr)) +-- We will have to save the whole directory hierarchy to +-- disk before the rover is rebooted. So that we can reassemble +-- the hierarchy, we will use Track 0 to store a "header". This +-- header will represent a `FSH [TrackNo]` object, where each +-- file is annotated with the list of tracks that contain its +-- chunks. + +-- The `mkHeader` function below will create this header +-- from a file system hierarchy where each file has been +-- annotated with a list of its chunks (assuming your +-- `Functor` instance is correct). + +mkHeader :: FSH [Chunk] -> FSH [TrackNo] +mkHeader = fmap (map (\(Chunk n _) -> n)) + + +-- Problem 9. Implement a function `assignTracks` which divides +-- all files in a hierarchy into chunks. Each chunk should have +-- be assigned its unique track number. Do not allocate track 0, +-- as that will be used to store the header. +-- Return `Nothing` if the given file system would not fit on +-- tracks 1-39 of a 40-track disk under your encoding. +-- HINT: You'll probably want to have a separate function +-- with return type `State TrackNo (FSH [Chunk])`. + +state_lambda :: [Word8] -> State TrackNo [Chunk] +state_lambda d = do + tn <- get + let (cc, tt) = (runState (chunks d) tn) + put tt + return cc + +--state_tracks :: FSH [Word8] -> State TrackNo (FSH [Chunk]) +--state_tracks fshd = do +-- state <- get + --m <- (mapM (\x -> do + -- c <- chunks x + -- return c + -- ) fshd) + --return m + +-- AHHHHHHHHHHHHHHHHHh +--state_tracks fshd = do + --let asdf = fmap state_lambda fshd + --return (fmap (state_lambda) fshd) + --return (fmap (\x -> evalState (state_lambda x) 1) fshd) + --return (fmap (\x -> evalState (state_lambda x) 1) fshd) + --return (fmap (\c -> do + -- let (cc, tt) = (runState (chunks c) tn) + -- return (head cc)) fshd) + --return (fmap (\c -> do + -- tn <- get + -- let cc = (evalState (chunks c) tn) + -- modify (+ fromIntegral (length cc)) + -- return cc) fshd) where +--fmap' :: FSH [Word8] +--fmap' f (File uid a) = (File uid (f a)) +--fmap' f (Dir uid arr) = (Dir uid (map (fmap f) arr)) + + +--assignTracks :: FSH [Word8] -> Maybe (FSH [Chunk]) +--assignTracks fshd = +-- if (tn >= tn_max) then Nothing else Just tracks where +-- (tracks, tn) = runState (state_tracks fshd) 1 + + +-- PART 4 - DISK CONTROLLER + +-- The disk controller supports four operations: +-- headForward - moves the read/write head forward by 1 track. +-- headBackward - moves the r/w head back toward zero by 1 track. +-- readTrack - reads 2048 consecutive bytes from the current track. +-- writeTrack - writes the given list of bytes to the current track. + +-- In this problem, you will develop a program `saveFSH` that +-- uses this monad to save the entire file system onto the disk. + +-- Problem 10. Write a program `headToTrack` that positions +-- the r/w head of the disk drive on the track with the given +-- number. If the number is larger than 39, position the head +-- on track 39. + +head_forward_n :: (MonadFloppy m) => Word8 -> m () +head_forward_n n = do + if (n > 0) then do + headForward + head_forward_n (n - 1) + else do + return () + +head_backward_n :: (MonadFloppy m) => Word8 -> m () +head_backward_n n = do + if (n > 0) then do + headBackward + head_backward_n (n - 1) + else do + return () + +headToTrack :: (MonadFloppy m) => Word8 -> m () +headToTrack p = do + head_backward_n 40 + head_forward_n p + +-- Problem 11. Write a program `saveChunk` which writes the +-- given chunk onto the appropriate track of the disk. + +saveChunk :: (MonadFloppy m) => Chunk -> m () +saveChunk (Chunk n (Encoded e)) = do + headToTrack n + writeTrack (replicate 2048 0) + writeTrack e + +-- The function below calculates the header of the +-- given given `FSH [Chunk]`, and saves it to track 0 +-- of the disk. Notice the use of the `toBytes` function. + +saveHeader :: (MonadFloppy m) => FSH [Chunk] -> m () +saveHeader fsh = do + headToTrack 0 + writeTrack (replicate 2048 0) + writeTrack (unEncoded $ encode $ toBytes $ mkHeader fsh) + + +-- Problem 12. Implement a program `saveFSH` that attemps to assign +-- track to the given `fsh` using `assignTracks`. If the assignment +-- was unsuccessful, the program should return False. +-- If the assignment was successful, the program should write the +-- header to track 0 of the disk, then write all the assigned chunks +-- onto the appropriate tracks. + +saveFSH :: (MonadFloppy m) => FSH [Word8] -> m Bool +saveFSH = error "'saveFSH' not implemented" + +-- Implement a program `loadFSH` that is able to reload a file +-- system from disk. I.e. if `saveFSH fsh` returns `True`, then +-- (saveFSH fsh >> loadFSH) should return `Just fsh`. +-- HINT: To load the header, you might want to use the `fromBytes` +-- function. + +loadFSH :: (MonadFloppy m) => m (Maybe (FSH [Word8])) +loadFSH = error "'loadFSH' not implemented" |