Mars Rover using a finite state machine implemented with mutually recursive functions and trampoline

I've continued working on the Mars Rover kata.

This time I've solved it using a finite state machine implemented with mutually recursive functions and trampoline.

Mutually recursive functions are a nice functional way to implement finite state machines and it's a functional way of expressing the state pattern (see Functional Programming Patterns in Scala and Clojure, Michael Bevilacqua-Linn).

As in the previous example using protocols, we have four possible states of the rover:

• The rover is facing north
• The rover is facing east
• The rover is facing south
• The rover is facing west

and we have four valid transitions from each state:

• Rotate left
• Rotate right
• Move forwards
• Move backwards

which correspond to the commands that the rover can receive.

These states and transitions can be directly translated to a set of mutually recursive functions by associating each state to a function:

• The rover is facing north -> facing-north
• The rover is facing east -> facing-east
• The rover is facing south -> facing-south
• The rover is facing west -> facing-west

and each transition as a condition to call the next function.

This is the new code of the rover name space:

	(ns mars-rover.rover
	(:require [mars-rover.worlds :refer [rover-not-hitting-obstacle wrap]]))
	(defn rover [x y direction]
	{:x x :y y :direction direction})
	(defn process [commands {direction :direction :as initial-rover} world]
	(let [wrap-rover (partial wrap world)]
	(letfn
	[(facing-north
	[{:keys [x y] :as current-rover} [command & rest-commands]]
	#(if command
	(case command
	:rotate-right
	(facing-east (rover x y :east) rest-commands)
	:rotate-left
	(facing-west (rover x y :west) rest-commands)
	:move-forwards
	(facing-north
	(rover-not-hitting-obstacle
	current-rover
	(wrap-rover (rover x (inc y) :north))
	world)
	rest-commands)
	:move-backwards
	(facing-north
	(rover-not-hitting-obstacle
	current-rover
	(wrap-rover (rover x (dec y) :north))
	world)
	rest-commands))
	current-rover))
	(facing-south
	[{:keys [x y] :as current-rover} [command & rest-commands]]
	#(if command
	(case command
	:rotate-right
	(facing-west (rover x y :west) rest-commands)
	:rotate-left
	(facing-east (rover x y :east) rest-commands)
	:move-forwards
	(facing-south
	(rover-not-hitting-obstacle
	current-rover
	(wrap-rover (rover x (dec y) :south))
	world)
	rest-commands)
	:move-backwards
	(facing-south
	(rover-not-hitting-obstacle
	current-rover
	(wrap-rover (rover x (inc y) :south))
	world)
	rest-commands))
	current-rover))
	(facing-east
	[{:keys [x y] :as current-rover} [command & rest-commands]]
	#(if command
	(case command
	:rotate-right
	(facing-south (rover x y :south) rest-commands)
	:rotate-left
	(facing-north (rover x y :north) rest-commands)
	:move-forwards
	(facing-east
	(rover-not-hitting-obstacle
	current-rover
	(wrap-rover (rover (inc x) y :east))
	world)
	rest-commands)
	:move-backwards
	(facing-east
	(rover-not-hitting-obstacle
	current-rover
	(wrap-rover (rover (dec x) y :east))
	world)
	rest-commands))
	current-rover))
	(facing-west
	[{:keys [x y] :as current-rover} [command & rest-commands]]
	#(if command
	(case command
	:rotate-right
	(facing-north (rover x y :north) rest-commands)
	:rotate-left
	(facing-south (rover x y :south) rest-commands)
	:move-forwards
	(facing-west
	(rover-not-hitting-obstacle
	current-rover
	(wrap-rover (rover (dec x) y :west))
	world)
	rest-commands)
	:move-backwards
	(facing-west
	(rover-not-hitting-obstacle
	current-rover
	(wrap-rover (rover (inc x) y :west))
	world)
	rest-commands))
	current-rover))
	(initial-state-fn
	[direction]
	(case direction
	:north facing-north
	:south facing-south
	:east facing-east
	:west facing-west))]
	(trampoline (initial-state-fn direction)
	initial-rover
	commands))))

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

Notice how inside each of the functions representing rover states (facing-north, facing-east, facing-south and facing-west), there is a case on the command which determines which of the functions will be called next, i. e., which is the next rover state.

Once the next function is selected, we pass it the rest of the commands (notice how destructuring is used to succinctly extract the first command and the rest of commands).

The recursion ends when there are no more commands (command will evaluate to nil), in which case we return the current-rover.

Ok, now some technical details:

1. Trampoline function. The trampoline function is used in order to make Clojure optimize the mutual recursion.
   Each state function returns a function returning a value (notice the # tacked onto the front of the outer level of each state function) instead of directly returning the value. This is required by the trampoline function so it can manage the stack on the mutually recursive calls to avoid stack consumption for long command sequences.
   To start the trampoline we feed it with the initial state function (given by get-initial-state-fn) and its parameters.
2. letfn form. Using letfn allows to create local functions which can refer to each other. This can't be done using let because it executes its bindings serially.

The rest of the name spaces have changed also a bit.

The commands name space now just translates from the received character signals to keywords representing each command:

	(ns mars-rover.commands)
	(def commands-by-message
	{"r" :rotate-right
	"l" :rotate-left
	"f" :move-forwards
	"b" :move-backwards})
	(defn create-from [messages]
	(map #(commands-by-message (str %)) messages))

view raw rover.commands-FSA.clj hosted with ❤ by GitHub

The worlds name space is nearly the same, I just added two helpers (wrap and rover-not-hitting-obstacle) so that the functions that do the wrapping and the collisions with obstacles checking are easier to use in rover name space (they also help to hide the inner structure of worlds):

	(ns mars-rover.worlds)
	(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 []})
	(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 wrap [world rover]
	((:wrap-fn world) rover))
	(defn rover-not-hitting-obstacle [current-rover next-rover {obstacles :obstacles}]
	(if (hit-obstacle? next-rover obstacles)
	current-rover
	next-rover))

view raw rover-worlds-FSA.clj hosted with ❤ by GitHub

Finally, the core name space is much simpler now:

	(ns mars-rover.core
	(:require [mars-rover.commands :as commands]
	[mars-rover.worlds :refer [infinite-world hit-obstacle?]]
	[mars-rover.rover :as rover]))
	(defn- validate-initial-position [rover {obstacles :obstacles}]
	(when (hit-obstacle? rover obstacles)
	(throw (IllegalArgumentException.
	"Initial position is on an obstacle!"))))
	(defn receive [rover messages & {world :world :or {world infinite-world}}]
	(validate-initial-position rover world)
	(rover/process (commands/create-from messages) rover world))

view raw rover-core-FSA.clj hosted with ❤ by GitHub

I'm using exactly the same tests I used in the three previous solutions:

1. Kata: Mars Rover in Clojure using multimethods
2. Separating Mars Rover code into different name spaces
3. Mars Rover code version using protocols instead of multimethods

so I won't post them again.

You can find the code of this last example in this GitHub repository.

I've discovered this other way of doing this in these two great books:

• The Joy of Clojure, Second Edition by Michael Fogus and Chris Houser which I'm enjoying reading at the moment and from which I've got many of the explanations in this post. I'm learning a lot with it.
• Functional Programming Patterns in Scala and Clojure by Michael Bevilacqua-Linn which is a great book from which you can learn how to express many design pattens in a functional (and most of the times much simpler) way.

I've learned a lot coding this solution.