Kata: Mars Rover in Clojure using multimethods

Yesterday we had a coding dojo in Clojure Developers Barcelona meetup.

We practiced together doing the Mars Rover kata.

I had already done this kata in Java and C++ before (several times) using the state pattern to eliminate all the conditionals on the rover direction and the command pattern to decouple the translation from the messages sent to the rover into commands acting on it.

As usual I used a mix of TDD and work on the REPL to code this Clojure version.

To document the process I committed the code after every passing test and every refactoring and also committed the REPL history. You can find the commits step by step here.

After making the rover rotations work I had a huge cond on the rover direction with an if branching on the command value inside each case.

It was time to refactor.

The suggestion in the kata was to try to eliminate conditionals using maps, multimethods and/or protocols.

First, I used multimethods, dispatching on the rover direction and the message it was receiving just to see how multimethods work.

It took me a while to make it work because I had a error in the arity of a defmethod and the stack trace was difficult for me to understand.

Then I realized that it was much better to separate the translation of messages into commands from the commands themselves. To do it I used a map that associate each message to the command multimethod:

	(def commands-by-message
	{"r" rotate-right
	"l" rotate-left
	"f" move-forwards
	"b" move-backwards})

view raw commands-by-message.clj hosted with ❤ by GitHub

Here you can see one of the multimethods:

	(defmulti rotate-left :direction)
	(defmethod rotate-left :north [{x :x y :y}]
	(rover x y :west))
	(defmethod rotate-left :south [{x :x y :y}]
	(rover x y :east))
	(defmethod rotate-left :east [{x :x y :y}]
	(rover x y :north))
	(defmethod rotate-left :west [{x :x y :y}]
	(rover x y :south))

view raw rotate-left-multi.clj hosted with ❤ by GitHub

From here on, coding the remaining commands using TDD was very easy. I just had to write a failing test and then make it pass by implementing its corresponding defmethod.

Once all the possible commands were working, I started with the functionality of wrapping the rover in a world.

If you check the commits, you'll see that I tried several approaches here because I wasn't sure how to model the world.

In the end, I decided to model the world as a map with a :wrap-fn key associated to the wrap function for a given kind of world. I passed the world map as a keyword parameter to the receive function which had a default value equal to infinite-world whose :wrap-fn was the identity function. That way all my previous tests continue to work without having to change them.

Then I started doing TDD to code the wrap function for a kind of world called squared-world which was created by a factory function by the same name.

Finally, I started with the obstacles which were modeled as a list of positions (which were represented by maps like {:x 1 :y 2}) associated to the :obstacles key in the world map.

To code the hit-obstacle? function I used the REPL for the first time (you can check all my tests on the REPL history which I also committed) to try to make it work using the some function.

After that I just added a validation to check if the initial position of the rover was on an obstacle.

These are the resulting tests using Midje:

	(ns mars-rover.core-test
	(:use midje.sweet)
	(:use [mars-rover.core]))
	(facts
	"about mars rover"
	(facts
	"rotations"
	(facts
	"when facing north"
	(fact
	"it turns right"
	(receive
	(rover 0 0 :north)
	"r") => (rover 0 0 :east))
	(fact
	"it turns left"
	(receive
	(rover 0 0 :north)
	"l") => (rover 0 0 :west)))
	(facts
	"when facing south"
	(fact
	"it turns right"
	(receive
	(rover 0 0 :south)
	"r") => (rover 0 0 :west))
	(fact
	"it turns left"
	(receive
	(rover 0 0 :south)
	"l") => (rover 0 0 :east)))
	(facts
	"when facing east"
	(fact
	"it turns right"
	(receive
	(rover 0 0 :east)
	"r") => (rover 0 0 :south))
	(fact
	"it turns left"
	(receive
	(rover 0 0 :east)
	"l") => (rover 0 0 :north)))
	(facts
	"when facing west"
	(fact
	"it turns right"
	(receive
	(rover 0 0 :west)
	"r") => (rover 0 0 :north))
	(fact
	"it turns left"
	(receive
	(rover 0 0 :west)
	"l") => (rover 0 0 :south))))
	(facts
	"movements"
	(facts
	"when facing north"
	(fact
	"it moves forwards"
	(receive
	(rover 0 0 :north)
	"f") => (rover 0 1 :north))
	(fact
	"it moves backwards"
	(receive
	(rover 0 0 :north)
	"b") => (rover 0 -1 :north)))
	(facts
	"when facing south"
	(fact
	"it moves forwards"
	(receive
	(rover 0 0 :south)
	"f") => (rover 0 -1 :south))
	(fact
	"it moves backwards"
	(receive
	(rover 0 0 :south)
	"b") => (rover 0 1 :south)))
	(facts
	"when facing east"
	(fact
	"it moves forwards"
	(receive
	(rover 0 0 :east)
	"f") => (rover 1 0 :east))
	(fact
	"it moves backwards"
	(receive
	(rover 0 0 :east)
	"b") => (rover -1 0 :east)))
	(facts
	"when facing west"
	(fact
	"it moves forwards"
	(receive
	(rover 0 0 :west)
	"f") => (rover -1 0 :west))
	(fact
	"it moves backwards"
	(receive
	(rover 0 0 :west)
	"b") => (rover 1 0 :west))))
	(fact
	"it can receive several messages"
	(receive
	(rover 0 0 :north)
	"brfflbrbrff") => (rover 1 -4 :south))
	(facts
	"being wrapped into a world"
	(let [world (square-world 1 1 2)]
	(receive
	(rover 1 3 :north)
	"f"
	:world world) => (rover 1 2 :north)
	(receive
	(rover 1 1 :south)
	"f"
	:world world) => (rover 1 2 :south)
	(receive
	(rover 3 1 :east)
	"f"
	:world world) => (rover 2 1 :east)
	(receive
	(rover 1 1 :west)
	"f"
	:world world) => (rover 2 1 :west)))
	(facts
	"hitting obstacles"
	(let [world (square-world 1 1 2 {:x 2 :y 2} {:x 2 :y 1})]
	(receive
	(rover 1 2 :east)
	"f"
	:world world) => (rover 1 2 :east)
	(receive
	(rover 1 2 :east)
	"lfrf"
	:world world) => (rover 2 3 :east)
	(receive
	(rover 1 2 :east)
	"lfrfrf"
	:world world) => (rover 2 3 :south)
	(fact
	"initial position not being on an obstacle"
	(receive
	(rover 2 2 :east) "f":world world)
	=> (throws IllegalArgumentException
	"Initial position is on an obstacle!")))))

view raw mars-rover-test.clj hosted with ❤ by GitHub

and this is the resulting code:

	(ns mars-rover.core)
	(defn rover [x y direction]
	{:x x :y y :direction direction})
	(defn square-world [x y size & obstacles]
	{:wrap-fn (fn [{x-rover :x y-rover :y :as rover}]
	(cond
	(and (> y-rover y)
	(> (- y-rover y) size))
	(assoc-in rover [:y] (- y-rover size))
	(and (< y-rover y)
	(< (- y y-rover) size))
	(assoc-in rover [:y] (+ y-rover size))
	(and (> x-rover x)
	(> (- x-rover x) size))
	(assoc-in rover [:x] (- x-rover size))
	(and (< x-rover x)
	(< (- x x-rover) size))
	(assoc-in rover [:x] (+ x-rover size))
	:else rover))
	:obstacles obstacles})
	(def infinite-world
	{:wrap-fn identity
	:obstacles []})
	(defmulti rotate-left :direction)
	(defmethod rotate-left :north [{x :x y :y}]
	(rover x y :west))
	(defmethod rotate-left :south [{x :x y :y}]
	(rover x y :east))
	(defmethod rotate-left :east [{x :x y :y}]
	(rover x y :north))
	(defmethod rotate-left :west [{x :x y :y}]
	(rover x y :south))
	(defmulti rotate-right :direction)
	(defmethod rotate-right :north [{x :x y :y}]
	(rover x y :east))
	(defmethod rotate-right :south [{x :x y :y}]
	(rover x y :west))
	(defmethod rotate-right :east [{x :x y :y}]
	(rover x y :south))
	(defmethod rotate-right :west [{x :x y :y}]
	(rover x y :north))
	(defmulti move-forwards :direction)
	(defmethod move-forwards :north [{x :x y :y direction :direction}]
	(rover x (inc y) direction))
	(defmethod move-forwards :south [{x :x y :y direction :direction}]
	(rover x (dec y) direction))
	(defmethod move-forwards :east [{x :x y :y direction :direction}]
	(rover (inc x) y direction))
	(defmethod move-forwards :west [{x :x y :y direction :direction}]
	(rover (dec x) y direction))
	(defmulti move-backwards :direction)
	(defmethod move-backwards :north [{x :x y :y direction :direction}]
	(rover x (dec y) direction))
	(defmethod move-backwards :south [{x :x y :y direction :direction}]
	(rover x (inc y) direction))
	(defmethod move-backwards :east [{x :x y :y direction :direction}]
	(rover (dec x) y direction))
	(defmethod move-backwards :west [{x :x y :y direction :direction}]
	(rover (inc x) y direction))
	(def commands-by-message
	{"r" rotate-right
	"l" rotate-left
	"f" move-forwards
	"b" move-backwards})
	(defn create-commands-from [messages]
	(map #(commands-by-message (str %)) messages))
	(defn hit-obstacle? [{x-rover :x y-rover :y} obstacles]
	(= (some #{{:x x-rover :y y-rover}} obstacles) {:x x-rover :y y-rover}))
	(defn apply-command
	[[rover {obstacles :obstacles wrap :wrap-fn :as world} :as rover-and-world] command]
	(let [new-rover (wrap (command rover))]
	(if (hit-obstacle? new-rover obstacles)
	rover-and-world
	[new-rover world])))
	(defn validate-initial-position [rover {obstacles :obstacles}]
	(when (hit-obstacle? rover obstacles)
	(throw (IllegalArgumentException.
	"Initial position is on an obstacle!"))))
	(defn apply-commands [rover world commands]
	(first (reduce apply-command [rover world] commands)))
	(defn receive
	[rover messages & {world :world :or {world infinite-world}}]
	(validate-initial-position rover world)
	(apply-commands rover world (create-commands-from messages)))

view raw mars-rover.clj hosted with ❤ by GitHub

I'm not sure if this is a good factorization for this problem in Clojure, (I feel that what I did for having different implementations of the wrap function is still a bit OO-ish), but it was a good exercise to practice with multimethods and start exploring their possibilities.

You can find the code in this GitHub repository.

Next time I'll try doing the same exercise using protocols instead.

I enjoyed a lot this coding dojo.

Thanks everyone for coming and Akamon for letting us use its facilities.

-----------

Update: I continued working in this code on Separating Mars Rover code into different name spaces, Mars Rover code version using protocols instead of multimethods and Mars Rover using a finite state machine implemented with mutually recursive functions and trampoline