public
Created

ClojureProgramming Issue 7 problem with Maze/Ariadne's Zip

  • Download Gist
test.clj
Clojure
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100
;; providing this for https://github.com/clojurebook/ClojureProgramming/issues/7
 
;; I just copy-pasted the relevant code from
;; https://github.com/clojurebook/ClojureProgramming/blob/master/ch03-collections-repl-interactions.clj
 
;; there were a couple changes. see comments below...
 
(defn maze
"Returns a random maze carved out of walls; walls is a set of
2-item sets #{a b} where a and b are locations.
The returned maze is a set of the remaining walls."
[walls]
(let [paths (reduce (fn [index [a b]]
(merge-with into index {a [b] b [a]}))
{} (map seq walls))
start-loc (rand-nth (keys paths))]
(loop [walls walls
unvisited (disj (set (keys paths)) start-loc)]
(if-let [loc (when-let [s (seq unvisited)] (rand-nth s))]
(let [walk (iterate (comp rand-nth paths) loc)
;;; CompilerException java.lang.RuntimeException: Unable to resolve symbol: <8> in this context, compiling:(NO_SOURCE_PATH:14)
;;; so, I removed the <8> at the end of this line
;;; steps (zipmap (take-while unvisited walk) (next walk))]<8>
steps (zipmap (take-while unvisited walk) (next walk))]
(recur (reduce disj walls (map set steps))
(reduce disj unvisited (keys steps))))
walls))))
 
(defn grid
[w h]
(set (concat
(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)]}))))
 
(require '[clojure.zip :as z])
 
(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])))
 
(defn draw
[w h maze path]
(doto (javax.swing.JFrame. "Maze")
(.setContentPane
(doto (proxy [javax.swing.JPanel] []
(paintComponent [^java.awt.Graphics g]
(let [g (doto ^java.awt.Graphics2D (.create g)
(.scale 10 10)
(.translate 1.5 1.5)
(.setStroke (java.awt.BasicStroke. 0.4)))]
(.drawRect g -1 -1 w h)
(doseq [[[xa ya] [xb yb]] (map sort maze)]
(let [[xc yc] (if (= xa xb)
[(dec xa) ya]
[xa (dec ya)])]
(.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)))
 
;; wrapped up the example in a (testit)
;; UPDATED with the erratum from cgrand...but I still see hangs.
;; UPDATED with cgrand's comment--fixed, I think!
(defn testit []
(let [w 40, h 40 ;; changed so I could see if the maze really had issues or not.
grid (grid w h)
walls (maze grid)
;;testit (draw w h walls #{}) ;; add drawing just to look at walls
labyrinth (reduce disj grid walls)
places (distinct (apply concat labyrinth))
theseus (rand-nth places)
minotaur (rand-nth places)
full-path #(conj (z/path %) (z/node %)) ; erratum
;;testit2 (do (println "theseus" theseus "minotaur" minotaur)
;; (println "labyrinth" labyrinth)) ;; add for testing
path (->> theseus
(ariadne-zip labyrinth)
(iterate z/next)
(filter #(= minotaur (second (z/node %)))) ; erratum: replace first with second
first full-path rest)] ; erratum: replaced z/path by full-path
(draw w h walls path))
)
 
;; just load a repl via java -jar clojure-1.3.0.jar
;; paste this text, then invoke (testit) multiple times.

Hi Christophe, I updated the code with your edit, but it still seems to hang for me. I think I got the edit right...can you take another look?

I made two sample testcases at the bottom of the gist. (testgood) returns the path. (testbad) hangs. If I run (testit) a few times, it produces other testcases that hang.

Roger: mea culpa, I commited straight from github interface (I wasn't on my
computer) and forgot one change: the first in filter must become a second
(because when in a dead-end the minotaur location never happens on the
left-hand side of a direction tuple). I hope this works this time. (I'll
commit a fix asap.)

Ah, that seems to fix it. See updated gist above--thanks!

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.