initial commit

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"