Threaded Mars Rovers in Clojure

mars_rovers_threaded.clj

(ns codelesson.mars-rovers-threaded)

;; Mars Rovers
;; Steve Butcher (sgwbutcher@yahoo.com)
;; Code Lesson - Week 3
;;
;; Utility functions

;; This function will take a map and switch the keys and values
;; The input map should have unique value as well as keys.
(defn reverse-map [m]                                                                                             
     (apply hash-map (flatten (map vector (vals m) (keys m)))))

;; Mars Rovers Application Code

;; data structures to map strings to keywords for the cardinal directions.
(def heading-keywords {"N" :north, "E" :east, "S" :south, "W" :west})
(def heading-strings (reverse-map heading-keywords))

;; This function takes two strings. The rover-location-string specifies the x and y
;; coordinates of the rover as well as its heading, for example, "1 2 E". The rover-command-string
;; specifies a series of commands the rover is to perform, for example, "MMLMMRMM" where "M" is move
;; "R" is rotate right and "L" is rotate left.
(defn make-rover [rover-location-string rover-command-string id]
     (let [
               fields (into [] (.split rover-location-string " "))
               commands (re-seq #"M|L|R" (apply str rover-command-string))]
          {  :id id,
	         :x (Integer/parseInt (fields 0)),
             :y (Integer/parseInt (fields 1)),
             :heading (heading-keywords (fields 2))
             :execution-counter 0
             :commands commands}))

;; These four functions change the heading of the rover to the named direction.
(defn face-north [rover]
     (assoc rover :heading :north))

(defn face-east [rover]
     (assoc rover :heading :east))

(defn face-south [rover]
     (assoc rover :heading :south))

(defn face-west [rover]
     (assoc rover :heading :west))

;; This hash stores the appropriate function to use to rotate a rover in the proper
;; direction given a command to rotate :left or :right and the rover's current heading.
(def rotations
     {:left
          { :north face-west, :west face-south, :south face-east, :east face-north},
      :right
           { :north face-east, :east face-south, :south face-west, :west face-north}})

;; A function to create a rotation function using the supplied direction (:left or :right),
;; we can create the two rotation function we need. In threaded case, rotations always
;; succeed.

(defn create-rotate-fn [direction]
     (fn [rover]
          ((get-in rotations [direction (:heading rover)]) rover)))

(def rotate-left (create-rotate-fn :left))
(def rotate-right (create-rotate-fn :right))

;; In the single-threaded version, moving always succeeds. The extra credit/multithreaded
;; version would have us check to see to if we either run off the plateau or run into
;; another rover. Because of data immutability, we can defer this.

(defn move-north [ rover]
     (assoc rover :y (+ (rover :y) 1)))

(defn move-south [ rover]
     (assoc rover :y (- (rover :y) 1)))

(defn move-east [ rover]
     (assoc rover :x (+ (rover :x) 1)))

(defn move-west [ rover]
     (assoc rover :x (- (rover :x) 1)))

;; movements is a hash that stores the appropriate move function for the rover's heading.
(def movements { :north move-north, :east move-east, :south move-south, :west move-west})

;; if the plateau "map" of rover locations contains this position
;; there's going to be a collision.
(defn rover-collision? [{:keys [plateau x y]}]
     (contains? (:rovers plateau) [x y]))

;; if the x or y is not between 0 and the limit of the plateau, the
;; rover will driver off the plateau.
(defn rover-off-plateau? [{:keys [plateau x y]}]
	(dosync
     	(or (not (<= 0 x (:x @plateau))) (not (<= 0 y (:y @plateau))))))

(defn record-change-on-plateau [old-rover new-rover]
	(dosync 
		(let [
			plateau (:plateau new-rover)
			old-x (:x old-rover)
			old-y (:y old-rover)
			new-x (:x new-rover)
			new-y (:y new-rover)
			rovers (:rovers @plateau)
			rover-removed (dissoc rovers [old-x old-y])
			rover-added (assoc rover-removed [new-x new-y] true)]
          (alter plateau #(assoc % :rovers rover-added)))
          new-rover))

;; we will only try a move command 5 times before giving up altogether. If we
;; succeed at executing a move command, we reset the counter to 0.
(defn reset-execution-counter [rover]
     (assoc rover :execution-counter 0))

;; if the rover has tried to move 5 times and hasn't been able to,
;; then we blank out the command sequence.
(defn reset-rover-commands [rover]
     (assoc rover :commands nil))

;; to pause the rover, we put the "M" command back onto the top of the stack
;; and increment the execution-counter by 1.
(defn pause-rover [{:keys [commands execution-counter] :as rover}]
     (assoc rover :commands (conj commands "M") :execution-counter (inc execution-counter)))

;; the move function is probably the most complicated because it is charged with
;; keeping the rover from running either off the plateau or into other rovers.
;; you can see it as first calculating the new location of the rover (new-rover)
;; and then checking to see if that's going to be "ok". If it is, then we
;; return this "new rover". If it's not, we return the old rover.
;;
;; There's a bit of bookkeeping that happens at the same time, however. The command sequence
;; is now stored in the rover as is the plateau "map".
(defn move [rover]
     (let [
          movement-fn (movements (rover :heading))
          new-rover (movement-fn rover)
          off-plateau? (rover-off-plateau? new-rover)
          collision? (rover-collision? new-rover)]
          (if (not (or off-plateau? collision?))
               (record-change-on-plateau rover (reset-execution-counter new-rover))
               (cond
                    off-plateau? (reset-rover-commands rover)
                    collision? (if (= 5 (:execution-counter new-rover))
                         (reset-rover-commands rover)
                         (pause-rover rover))))))

;; command-codes is a hash for looking up the command code in a command string and returning
;; the function that correctly implements that command.
(def command-codes { "M" move, "L" rotate-left, "R" rotate-right})

(defn command-rover [{:keys [ id commands] :as rover}]
	(do
		(Thread/sleep (+ 500 (rand-int 1000)))
		(let [[command-code & remaining-codes] commands]
		   (if (nil? command-code)
		        rover
		        (let [
		        	 _ (println "Rover " id " executing " command-code)
		             command (command-codes command-code)
		             rover-w-updated-commands (assoc rover :commands remaining-codes)
		             updated-rover (command rover-w-updated-commands)]
		                  (recur updated-rover))))))

(defn make-plateau [grid-size-str]
     (let [fields (into [] (.split grid-size-str " "))]
          { :x (Integer/parseInt (fields 0)), :y (Integer/parseInt (fields 1)), :rovers {}}))

(defn add-rovers-to-plateau [rovers plateau]
     (let [rover-locations (reduce (fn [m {:keys [x y]}] (assoc m [ x y] true)) {} rovers)]
     	(dosync 
          (alter plateau #(assoc % :rovers rover-locations))
          plateau)))

(defn add-plateau-to-rovers [plateau rovers]
     (map #(assoc % :plateau plateau) rovers))

;; this function parses the problem data including the dimensions of
;; the plateau and the locations and commands for all rovers. The format is:
;; 5 5
;; 1 2 N
;; LMLMLMLMM
;; 3 3 E
;; MMRMMRMRRM
;; where the first line is the size of the grid (which is currently ignored) and each
;; successive line is the starting location of a rover and the command string for that
;; rover.
(defn read-rover-input [input]
     (let [
         lines (into [] (.split input "\n"))
        plateau (ref (make-plateau (first lines)))
        rover-lines (rest lines)
        rover-data (partition 2 rover-lines)
        rovers (map #(make-rover (first %1) (rest %1) %2) rover-data (range (count rover-data)))]
          { :plateau plateau, :rovers rovers}))

(defn initialize-rover-data [input]
     (let [
          {:keys [plateau rovers]} (read-rover-input input)
          new-plateau (add-rovers-to-plateau rovers plateau)]
          	(add-plateau-to-rovers plateau rovers)))

(defn run-rovers [input]
	(pmap command-rover (initialize-rover-data input)))

;; returns a string representation of a rover.
(defn rover-to-string [{:keys [x y heading]}]
     (str x " " y " " (heading-strings heading)))

;; returns a string representing all of the rovers.
(defn rovers-to-string [rovers]
     (apply str (interpose "\n" (map rover-to-string rovers))))

;; starting with an input string, this function will the final locations of
;; all rovers.
(defn run [input]
     (rovers-to-string (run-rovers input)))

;; usage:
;; (run "5 5\n1 2 N\nLMLMLMLMM\n3 3 E\nMMRMMRMRRM")
;; result:
;; "1 3 N\n5 1 E\n"

;; one possible outcome:
;; user=> (println (run "5 5\n1 2 N\nLRMLMLMLMM\n3 3 E\nMMRMMRMRRM"))
;; Rover  0  executing  L
;; Rover  1  executing  M
;; Rover  0  executing  R
;; Rover  1  executing  M
;; Rover  0  executing  M
;; Rover  1  executing  R
;; Rover  0  executing  L
;; Rover  1  executing  M
;; Rover  0  executing  M
;; Rover  0  executing  L
;; Rover  1  executing  M
;; Rover  0  executing  M
;; Rover  0  executing  L
;; Rover  1  executing  R
;; Rover  1  executing  M
;; Rover  0  executing  M
;; Rover  1  executing  R
;; Rover  0  executing  M
;; Rover  1  executing  R
;; Rover  1  executing  M
;; 2 2 E
;; 5 1 E
;; nil