Permalink
Browse files

Ariadne's zipper

  • Loading branch information...
1 parent 85cc30e commit 76caed366f00d4b0ba738cf947ca6ca0341b6a34 @ndpar committed Aug 2, 2016
Showing with 42 additions and 5 deletions.
  1. +42 −5 src/cljprog/maze.clj
View
@@ -2,6 +2,7 @@
;; https://github.com/clojurebook/ClojureProgramming/blob/master/ch03-collections-repl-interactions.clj
(ns cljprog.maze)
+(require '[clojure.zip :as z])
(defn maze
"Returns a random maze carved out of walls; walls is a set of
@@ -29,7 +30,7 @@
(for [i (range (dec w)) j (range h)] #{[i j] [(inc i) j]})
(for [i (range w) j (range (dec h))] #{[i j] [i (inc j)]}))))
-(defn draw [w h maze]
+(defn draw [w h maze path]
(doto (javax.swing.JFrame. "Maze")
(.setContentPane
(doto (proxy [javax.swing.JPanel] []
@@ -43,16 +44,20 @@
(let [[xc yc] (if (= xa xb)
[(dec xa) ya]
[xa (dec ya)])]
- (.drawLine g xa ya xc yc))))))
+ (.drawLine g xa ya xc yc)))
+ (.translate g -0.5 -0.5)
+ (.setColor g java.awt.Color/RED)
+ (doseq [[[xa ya] [xb yb]] path]
+ (.drawLine g xa ya xb yb)))))
(.setPreferredSize (java.awt.Dimension. (* 10 (inc w)) (* 10 (inc h))))))
.pack
(.setVisible true)))
; (ns cljprog.maze)
; (load "maze")
-; (draw 3 3 #{#{[1 0] [1 1]} #{[2 1] [1 1]} #{[0 0] [0 1]} #{[1 1] [1 2]}})
-; (draw 40 40 (maze (grid 40 40)))
+; (draw 3 3 #{#{[1 0] [1 1]} #{[2 1] [1 1]} #{[0 0] [0 1]} #{[1 1] [1 2]}} ())
+; (draw 40 40 (maze (grid 40 40)) ())
(defn hex-grid
[w h]
@@ -101,4 +106,36 @@
(.setVisible true)))
; (hex-draw 3 3 (hex-grid 3 3))
-; (hex-draw 20 20 (maze (hex-grid 20 20)))
+; (hex-draw 20 20 (maze (hex-grid 20 20)))
+
+(defn ariadne-zip
+ [labyrinth loc]
+ (let [paths (reduce (fn [index [a b]]
+ (merge-with into index {a [b] b [a]}))
+ {} (map seq labyrinth))
+ children (fn [[from to]]
+ (seq (for [loc (paths to)
+ :when (not= loc from)]
+ [to loc])))]
+ (z/zipper (constantly true)
+ children
+ nil
+ [nil loc])))
+
+(let [w 40 h 40
+ grid (grid w h)
+ walls (maze grid)
+ labyrinth (reduce disj grid walls)
+ places (distinct (apply concat labyrinth))
+ theseus (rand-nth places)
+ minotaur (rand-nth places)
+ path (->> theseus
+ (ariadne-zip labyrinth)
+ (iterate z/next)
+ (filter #(= minotaur (first (z/node %))))
+ first z/path rest)]
+ (println "Path:" path)
+ (draw w h walls path))
+
+; (ns cljprog.maze)
+; (load "maze")

0 comments on commit 76caed3

Please sign in to comment.