Added assign5 starter code

assignments/assign5.markdown

@@ -6,9 +6,12 @@ title: Assignment 5
 
 This week's homework is to complete an implementation of Harold the Robot.
 The starter code can be found [here](https://gitlab.com/stanford-lambda/stanford-lambda.gitlab.io/tree/master/starter-code/assignment5).
+Note that since some additional configuration is required to enable the packages
+used, you should clone the `harold` folder directly rather than just the source
+code in `src`.
 
 The homework is simply to complete the functions which are marked incomplete in
-the starter code. Modifications should be made to `Harold.hs`, while `World.hs` 
+the starter code. Modifications should be made to `Harold.hs` and `Main.hs`, while `World.hs` 
 provides the types and functions required to create the World that Harold lives in.
 `Main.hs` can be run either by running `main` in ghci or by building and
 executing the project. After implementing the required functions, Harold should

starter-code/assignment5/harold/LICENSE

@@ -0,0 +1,30 @@
+Copyright Author name here (c) 2019
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Author name here nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

starter-code/assignment5/harold/README.md

@@ -0,0 +1 @@
+# harold

starter-code/assignment5/harold/Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

starter-code/assignment5/harold/harold.cabal

@@ -0,0 +1,26 @@
+name:                harold
+version:             0.1.0.0
+-- synopsis:
+-- description:
+homepage:            https://github.com/githubuser/harold#readme
+license:             BSD3
+license-file:        LICENSE
+author:              Author name here
+maintainer:          [email protected]
+copyright:           2019 Author name here
+category:            Web
+build-type:          Simple
+cabal-version:       >=1.10
+extra-source-files:  README.md
+
+executable harold
+  hs-source-dirs:      src
+  main-is:             Main.hs
+  default-language:    Haskell2010
+  build-depends:       base >= 4.7 && < 5
+                     , grid >= 7.8
+                     , matrix >= 0.2
+                     , mtl >= 2.2
+                     , monad-loops >= 0.4
+                     , random >= 1.1
+                     , extra >= 1.1

starter-code/assignment5/harold/src/Harold.hs

@@ -0,0 +1,63 @@
+module Harold where
+
+import Data.Matrix
+import Control.Monad.State.Lazy
+import Control.Monad.Extra
+
+import World
+
+move :: State World ()
+move = do
+    dir   <- gets getDir
+    (r,c) <- gets getPos
+    let newPos = case dir of
+                   North -> (r + 1, c)
+                   South -> (r - 1, c)
+                   East  -> (r, c + 1)
+                   West  -> (r, c - 1)
+    whenM frontIsClear $ modify (\w -> w { getPos = newPos })
+
+turnLeft :: State World ()
+turnLeft = do
+    dir <- gets getDir
+    let newDir = case dir of
+                   North -> West
+                   West  -> South
+                   South -> East
+                   East  -> North
+    modify (\w -> w { getDir = newDir })
+
+putBeeper :: State World ()
+putBeeper = do
+    pos <- gets getPos
+    grid <- gets getGrid
+    bagBeeps <- gets getBag
+    let cellBeeps = grid ! pos
+    whenM beepersInBag $ modify (\w ->
+        w { getGrid = setElem (cellBeeps + 1) pos grid 
+          , getBag = bagBeeps })
+
+frontIsClear :: State World Bool
+frontIsClear = do
+    World (r,c) dir _ grid <- get
+    pure $ case dir of
+             North -> r < nrows grid
+             West  -> c > 1
+             South -> r > 1
+             East  -> c < ncols grid
+
+beepersPresent :: State World Bool
+beepersPresent = do
+    pos <- gets getPos
+    gets ((> 0) . (! pos) . getGrid)
+
+-- INCOMPLETE return whether any beepers are in the bag
+beepersInBag :: State World Bool
+beepersInBag = pure False
+
+facing :: State World Direction
+facing = gets getDir
+
+-- INCOMPLETE increment the number of beepers in the bag, return ()
+craftBeeper :: State World ()
+craftBeeper = pure ()

starter-code/assignment5/harold/src/Main.hs

@@ -0,0 +1,42 @@
+module Main where
+
+import Data.Matrix
+
+import Control.Monad.State.Lazy
+import Control.Monad.Loops
+
+import System.Random
+
+import Harold
+import World
+
+main :: IO ()
+main = do
+    world <- randomEmptyWorld 5 6
+    putStrLn $ show world
+    putStrLn $ show $ execState program world
+
+program :: State World ()
+program = do
+    markCorners
+
+markCorners :: State World ()
+markCorners = do
+    moveToStart
+    replicateM_ 4 craftBeeper
+    replicateM_ 4 (moveToWall *> putBeeper *> turnLeft)
+
+moveToStart :: State World ()
+moveToStart = do
+    face South
+    moveToWall
+    face West
+    moveToWall
+    face East
+
+face :: Direction -> State World ()
+face dir = whileM_ ((/= dir) <$> facing) turnLeft -- whileM_ is from Control.Monad.Loops
+
+-- INCOMPLETE return () and move forward till Harold hits a wall
+moveToWall :: State World ()
+moveToWall = return ()

starter-code/assignment5/harold/src/World.hs

@@ -0,0 +1,69 @@
+module World where
+
+import Data.Matrix -- provides a matrix datatype
+import System.Random -- provides the Random typeclass
+import Control.Monad.State.Lazy -- provides the State monad and MonadState typeclass
+
+type Beepers = Int
+type Grid = Matrix Beepers
+
+type Pos = (Int, Int)
+data Direction = North | South | East | West
+    deriving (Eq, Ord, Bounded, Enum)
+
+instance Show Direction where
+    show North = "^"
+    show West  = "<"
+    show South = "v"
+    show East  = ">"
+
+instance Random Direction where
+    random g = case randomR (fromEnum (minBound :: Direction),
+                             fromEnum (maxBound :: Direction)) g of
+                 (r, g') -> (toEnum r, g')
+    randomR (a,b) g = case randomR (fromEnum a, fromEnum b) g of
+                        (r, g') -> (toEnum r, g')
+
+data Label = Label { getState   :: (Maybe Direction)
+                   , getBeepers :: Beepers }
+
+instance Show Label where
+    show l = harold ++ beepers
+      where harold = case getState l of
+                       Nothing -> " "
+                       Just d  -> show d
+            beepers = if getBeepers l > 0 then "x" else "o"
+
+data World = World { getPos  :: Pos
+                   , getDir  :: Direction
+                   , getBag :: Int
+                   , getGrid :: Grid }
+
+instance Show World where
+  show (World pos dir _ grid) = show $ orient $ labelHarold $ labelBeepers <$> grid
+    where labelBeepers = Label Nothing
+          labelHarold = do
+              Label _ beeps <- uncurry getElem pos
+              setElem (Label (Just dir) beeps) pos
+          orient m = matrix (nrows m) (ncols m) $ \(i,j) -> m ! (nrows m - i + 1, j)
+
+emptyGrid :: Int -> Int -> Grid
+emptyGrid rows cols = matrix rows cols (const 0)
+
+emptyWorld :: Int -> Int -> World
+emptyWorld rows cols = World (1,1) East 0 $ emptyGrid rows cols
+
+randomPos :: Int -> Int -> IO Pos
+randomPos rows cols = do
+    rowPos <- randomRIO (1, rows)
+    colPos <- randomRIO (1, cols)
+    return (rowPos, colPos)
+
+randomEmptyWorld :: Int -> Int -> IO World
+randomEmptyWorld rows cols = do
+    pos <- randomPos rows cols
+    dir <- randomIO
+    pure $ World { getPos = pos
+                 , getDir = dir
+                 , getBag = 0 
+                 , getGrid = emptyGrid rows cols }

starter-code/assignment5/harold/stack.yaml

@@ -0,0 +1,66 @@
+# This file was automatically generated by 'stack init'
+#
+# Some commonly used options have been documented as comments in this file.
+# For advanced use and comprehensive documentation of the format, please see:
+# https://docs.haskellstack.org/en/stable/yaml_configuration/
+
+# Resolver to choose a 'specific' stackage snapshot or a compiler version.
+# A snapshot resolver dictates the compiler version and the set of packages
+# to be used for project dependencies. For example:
+#
+# resolver: lts-3.5
+# resolver: nightly-2015-09-21
+# resolver: ghc-7.10.2
+# resolver: ghcjs-0.1.0_ghc-7.10.2
+#
+# The location of a snapshot can be provided as a file or url. Stack assumes
+# a snapshot provided as a file might change, whereas a url resource does not.
+#
+# resolver: ./custom-snapshot.yaml
+# resolver: https://example.com/snapshots/2018-01-01.yaml
+resolver: lts-13.8
+
+# User packages to be built.
+# Various formats can be used as shown in the example below.
+#
+# packages:
+# - some-directory
+# - https://example.com/foo/bar/baz-0.0.2.tar.gz
+# - location:
+#    git: https://github.com/commercialhaskell/stack.git
+#    commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
+# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a
+#  subdirs:
+#  - auto-update
+#  - wai
+packages:
+- .
+# Dependency packages to be pulled from upstream that are not in the resolver
+# using the same syntax as the packages field.
+# (e.g., acme-missiles-0.3)
+extra-deps: 
+- grid-7.8.12
+
+# Override default flag values for local packages and extra-deps
+# flags: {}
+
+# Extra package databases containing global packages
+# extra-package-dbs: []
+
+# Control whether we use the GHC we find on the path
+# system-ghc: true
+#
+# Require a specific version of stack, using version ranges
+# require-stack-version: -any # Default
+# require-stack-version: ">=1.7"
+#
+# Override the architecture used by stack, especially useful on Windows
+# arch: i386
+# arch: x86_64
+#
+# Extra directories used by stack for building
+# extra-include-dirs: [/path/to/dir]
+# extra-lib-dirs: [/path/to/dir]
+#
+# Allow a newer minor version of GHC than the snapshot specifies
+# compiler-check: newer-minor