Instantly share code, notes, and snippets.

@rm-hull /maze.cljs
Last active Dec 24, 2015

Embed
What would you like to do?
Maze generator and solver using Dijkstra's graph search algorithm, served up in ClojureScript & rendered on a HTML5 canvas. Try adding ?draw=X to the URL where X is one of none, path, snake or snail
(ns maze.core
(:use [enchilada :only [canvas ctx value-of canvas-size]]
[monet.canvas :only [get-context stroke stroke-style stroke-cap begin-path close-path line-to move-to stroke-width]]
[monet.core :only [animation-frame]]
[jayq.core :only [$ document-ready data attr hide show]]
[maze.util :only [coord->pos]]
[maze.generator :only [create-maze]]
[maze.solver :only [solve]]))
(defn draw-path-segments [ctx snake start end]
(let [[w h] (get-in snake [:maze :size])
cell-size (get-in snake [:cell-size])
offset (inc (quot cell-size 2))]
(doseq [p (subvec (:path snake) start end)
:let [x (rem p w)
y (rem (quot p w) h)]]
(line-to
ctx
(+ (* x cell-size) offset)
(+ (* y cell-size) offset)))
ctx)) ; important to return ctx for threading
(defn eraser [ctx snake p]
(if (and (>= p 0) (< p (:limit snake)))
(->
ctx
(stroke-style (:erase-color snake))
(begin-path)
(draw-path-segments snake p (+ p 2))
(stroke)
(close-path)))
ctx) ; important to return ctx for threading
(defn draw-snake [ctx snake]
(let [start (deref (:counter snake))
end (+ start (:snake-length snake))]
(->
ctx
(stroke-width 4)
(stroke-cap "square")
(eraser snake (dec start))
(stroke-style (:color snake))
(begin-path)
(draw-path-segments snake start end)
(stroke)
(close-path))))
(defn draw-cells [ctx maze cell-size]
(let [[w h] (:size maze)]
(doseq [[p walls] (map vector (iterate inc 0) (:data maze))
:let [x (inc (* cell-size (rem p w)))
y (inc (* cell-size (rem (quot p w) h)))]]
(when (:north walls) (-> ctx (move-to x y) (line-to (+ x cell-size) y)))
(when (:west walls) (-> ctx (move-to x y) (line-to x (+ y cell-size)))))
ctx)) ; important to return ctx for threading
(defn draw-maze [ctx maze cell-size]
(let [[w h] (:size maze)]
(->
ctx
(stroke-width 2)
(stroke-cap "square")
(stroke-style "#606060")
(begin-path)
(move-to 0 (inc (* h cell-size)))
(line-to (inc (* w cell-size)) (inc (* h cell-size)))
(line-to (inc (* w cell-size)) 0)
(draw-cells maze cell-size)
(stroke)
(close-path))))
(defn start-end [snake-attrs]
(map #(vector (:start %) (:end %)) snake-attrs))
(defn create-snake [ctx maze callback-fn & snake-attrs]
(let [solutions (solve maze (start-end snake-attrs))]
(doseq [index (range (count solutions))
:let [path (nth solutions index)
attrs (nth snake-attrs index)
snake-length (get attrs :snake-length (count path))]]
(callback-fn
ctx
(assoc attrs
:maze maze
:path path
:counter (atom 0)
:snake-length snake-length
:limit (- (count path) snake-length))))))
(defn reset-snake [ctx snake callback-fn]
(let [start (nth (get-in snake [:maze :path]) @(:counter snake))
end (rand-int (dec (apply * (get-in snake [:maze :size]))))]
(create-snake ctx (:maze snake) callback-fn (assoc snake :start start :end end))))
(defn animate [ctx snake]
(letfn [(loop []
(if (<= @(:counter snake) (:limit snake))
(do
(animation-frame loop)
(draw-snake ctx snake)
(swap! (:counter snake) inc))))]
(loop)))
(defn random-snakes [cell-size limit n]
(->>
(cycle ["#55B95F" "red" "#8182AE" "#AC85B5" "orange" "yellow"])
(map #(hash-map :start (rand-int limit) :end (rand-int limit) :cell-size cell-size :color % :erase-color "white" :snake-length 8))
(take n)
vec))
(document-ready
(fn []
(let [cell-size (js/parseInt (value-of :cell-size 10))
draw-cmd (value-of :draw "snail")
width (dec (quot (first (canvas-size)) cell-size))
height (dec (quot (second (canvas-size)) cell-size))
limit (dec (* width height))
maze (create-maze rand-int width height)]
(show canvas)
(draw-maze ctx maze cell-size)
(case (str draw-cmd)
"path" (do (create-snake ctx maze draw-snake {:start 0 :end limit :cell-size cell-size :color "red" :erase-color "red"}) (hide-spinner))
"snail" (create-snake ctx maze animate {:start 0 :end limit :cell-size cell-size :color "#8182AE" :erase-color "#E2E2F1" :snake-length 3})
"snake" (apply (partial create-snake ctx maze animate) (random-snakes cell-size limit (value-of :count 5)))
:else nil))))
(ns maze.solver
(:use [maze.util :only [neighbours wall-between?]]
[tailrecursion.priority-map :only [priority-map]]))
(defn- connecting-neighbours
"Yields a list of directly connected neighbours (i.e. adjacent cells with
no walls between them)."
[maze p]
(->> (neighbours p (:size maze))
(remove (partial wall-between? maze p))))
(defn- remove-longer-paths
"Filters out those neighbours from the predecessors whose length is greater
than the current length"
[pred neighbours curr-len]
(remove #(if-let [old (pred %)] (>= curr-len (:length old))) neighbours))
(defn- path-length
"Given a map of predecessors of a specific start point, extract out the
length for the cell at offset n."
[pred n]
(get-in pred [n :length] 0))
(defn- blend-in
"Blends the neighbours (as keys) into the map all with the same value."
[map neighbours val]
(if (empty? neighbours)
map
(apply (partial assoc map) (mapcat vector neighbours (repeat val)))))
(defn- build-predecessors
"Constructs a map of predessors for cells between 'start' and 'stop-at' cells."
[maze start stop-at]
(loop [pred (hash-map start { :predecessor nil :length 0 })
active (priority-map start 0)]
(cond
(empty? active) pred
(= (first active) stop-at) pred
:else (let [curr (ffirst active)
new-length (inc (path-length pred curr))
neighbours (remove-longer-paths pred (connecting-neighbours maze curr) new-length)
next-gen (blend-in pred neighbours (hash-map :predecessor curr :length new-length))
next-active (blend-in active neighbours new-length)]
(recur
next-gen
(dissoc next-active curr))))))
;; Dijkstra's Graph Search
(defn shortest-path
"Recurses over the predecessors between 'from' and 'to' pulling out the
cells into an ordered list which represents the shortest path between
the two points."
[maze from to]
(let [pred (build-predecessors maze from to)]
(loop [n to
result nil]
(let [p (get-in pred [n :predecessor])]
(if (nil? p)
(vec (cons n result))
(recur p (cons n result)))))))
(defn solve [maze points]
(let [f (fn [[from to]] (shortest-path maze from to))]
(vec (map f points))))
(ns maze.util)
(defn coord->pos
"Converts [x,y] co-ords into an offset into the maze data"
[[^long x ^long y] [^long w ^long h]]
(+
(* (rem y h) w)
(rem x w)))
(defn- add-if [pred then-clause xs]
(if pred
(cons then-clause xs)
xs))
(def neighbours
(memoize
(fn [^long p [^long w ^long h]]
(->> [(- p w) (+ p w)]
(add-if (> (rem p w) 0) (dec p))
(add-if (< (rem p w) (dec w)) (inc p))
(filter #(and (>= % 0) (< % (* w h))))))))
(defn wall-between?
"Checks to see if there is a wall between two (adjacent) points in the
maze. The return value will indicate the wall type (:north, :west, ..).
If the points aren't adjacent, nil is returned."
[maze ^long p1 ^long p2]
(if (> p1 p2)
(wall-between? maze p2 p1)
(let [[w h] (:size maze)]
(cond
(= (- p2 p1) w) (:north ((:data maze) p2))
(= (- p2 p1) 1) (:west ((:data maze) p2))))))
(ns maze.generator
(:use [maze.util :only [neighbours]]))
(defn- init-maze
"Initialize a maze of size (W x H) with all walls set"
[^long w ^long h]
{ :size [w h]
:data (into [] (repeat (* w h) #{ :north :west } ))})
(defn- knockdown-wall
"Knocks down the wall between the two given points in the maze. Assumes
that they are adjacent, otherwise it doesn't make any sense (and wont
actually make any difference anyway)"
[maze ^long p1 ^long p2]
(if (> p1 p2)
(knockdown-wall maze p2 p1)
(let [[w h] (:size maze)
new-walls (cond
(= (- p2 p1) w) (disj ((:data maze) p2) :north)
(= (- p2 p1) 1) (disj ((:data maze) p2) :west))]
(assoc-in maze [:data p2] new-walls))))
(defn create-maze
"Recursively creates a maze based on the supplied dimensions. The visitor
function allows a different strategy for selecting the next neighbour."
[visitor-fn ^long w ^long h]
(loop [maze (init-maze w h)
visited {0 true}
stack [0]]
(if (empty? stack)
maze
(let [n (remove visited (neighbours (peek stack) (:size maze)))]
(if (empty? n)
(recur maze visited (pop stack))
(let [np (nth n (visitor-fn (count n)))
st (if (= (count n) 1) (pop stack) stack)]
(recur
(knockdown-wall maze (peek stack) np)
(assoc visited np true)
(conj st np))))))))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment