Better solutions + bugfix

solutions/build-zipper.clj

@@ -36,7 +36,10 @@
      (fn [zipper] (first (:parents zipper))));
 
 (def zroot
-     (fn [zipper] (znode (last (:parents zipper)))))
+     (fn [zipper]
+       (if (empty? (:parents zipper))
+         (znode zipper)
+         (zroot (zup zipper)))))
 
 
 
@@ -83,8 +86,8 @@
 
 (def zreplace
      (fn [zipper subtree]
-       (assoc zipper
-         :here subtree)))
+       (assoc zipper :here subtree)))
+
 
 
 ;;; Exercise 5
@@ -110,12 +113,15 @@
                  :here (concat (:lefts zipper) (list (:here zipper)) (:rights zipper))
                  :changed true)))))
 
+;; The earlier version of zroot already works. Here it is again:
 (def zroot
      (fn [zipper]
        (if (empty? (:parents zipper))
          (znode zipper)
          (zroot (zup zipper)))))
 
+
+
 ;;; Exercise 6
 
 ;; Step 1
@@ -131,15 +137,16 @@
 (def znext
      (fn [zipper]
        (cond (and (zbranch? zipper)
-                  (not (nil? (zdown zipper))))
-             (zdown zipper)
+                  (not (nil? (zdown zipper))))   ; (1)
+             (zdown zipper)                      ; (2)
 
              :else
              (zright zipper))))
 
-;; However, having the second `cond` form repeat the last clause of the preceding test is
-;; a hint that we should maybe take advantage of the way that boolean operations return
-;; the last value evaluated and turn the whole thing into an `or`:
+;; However, having line (2) repeat the `zdown` from line (1) is a hint
+;; that we should maybe take advantage of the way that boolean
+;; operations return the last value evaluated. That lets us turn the
+;; whole `cond` into an `or`:
 
 (def znext
      (fn [zipper]
@@ -162,7 +169,7 @@
              (search-up zipper)))))
 
 
-;; Step 3
+;; Step 4
 
 (def zend? :end?)
 

solutions/pieces/build-zipper-2.clj

@@ -19,7 +19,10 @@
      (fn [zipper] (first (:parents zipper))));
 
 (def zroot
-     (fn [zipper] (znode (last (:parents zipper)))))
+     (fn [zipper]
+       (if (empty? (:parents zipper))
+         (znode zipper)
+         (zroot (zup zipper)))))
 
 
 

solutions/pieces/build-zipper-4.clj

@@ -2,7 +2,7 @@
 
 (def zreplace
      (fn [zipper subtree]
-       (assoc zipper
-         :here subtree)))
+       (assoc zipper :here subtree)))
+
 
 

solutions/pieces/build-zipper-5.clj

@@ -21,9 +21,12 @@
                  :here (concat (:lefts zipper) (list (:here zipper)) (:rights zipper))
                  :changed true)))))
 
+;; The earlier version of zroot already works. Here it is again:
 (def zroot
      (fn [zipper]
        (if (empty? (:parents zipper))
          (znode zipper)
          (zroot (zup zipper)))))
 
+
+

solutions/pieces/build-zipper-6b.clj

@@ -7,15 +7,16 @@
 (def znext
      (fn [zipper]
        (cond (and (zbranch? zipper)
-                  (not (nil? (zdown zipper))))
-             (zdown zipper)
+                  (not (nil? (zdown zipper))))   ; (1)
+             (zdown zipper)                      ; (2)
 
              :else
              (zright zipper))))
 
-;; However, having the second `cond` form repeat the last clause of the preceding test is
-;; a hint that we should maybe take advantage of the way that boolean operations return
-;; the last value evaluated and turn the whole thing into an `or`:
+;; However, having line (2) repeat the `zdown` from line (1) is a hint
+;; that we should maybe take advantage of the way that boolean
+;; operations return the last value evaluated. That lets us turn the
+;; whole `cond` into an `or`:
 
 (def znext
      (fn [zipper]

solutions/pieces/build-zipper-6d.clj

@@ -1,5 +1,5 @@
 
-;; Step 3
+;; Step 4
 
 (def zend? :end?)
 

test/solutions/ts_build_zipper.clj

@@ -18,6 +18,8 @@
   (-> '() seq-zip zdown) => nil
   (-> '(a b c) seq-zip zdown zup znode) => '(a b c)
   (-> '(a b c) seq-zip zup) => nil
+  (-> '() seq-zip zroot) => '()
+  (-> '(a) seq-zip zroot) => '(a)
   (-> '(((a)) b c) seq-zip zdown zdown zdown zroot) => '(((a)) b c))
 
 (load-file "solutions/pieces/build-zipper-3.clj")
@@ -30,6 +32,8 @@
   (-> '(a b c) seq-zip zdown zup znode) => '(a b c)
   (-> '(a b c) seq-zip zup) => nil
   (-> '() seq-zip zdown) => nil
+  (-> '() seq-zip zroot) => '()
+  (-> '(a) seq-zip zroot) => '(a)
   (-> '(((a)) b c) seq-zip zdown zdown zdown zroot) => '(((a)) b c)
   (-> (seq-zip '(a b c)) zdown zright znode) => 'b
   (-> (seq-zip '(a b c)) zdown zup znode) => '(a b c)
@@ -47,6 +51,8 @@
   (-> '(a b c) seq-zip znode) => '(a b c)
   (-> '(a b c) seq-zip zdown zup znode) => '(a b c)
   (-> '(a b c) seq-zip zup) => nil
+  (-> '() seq-zip zroot) => '()
+  (-> '(a) seq-zip zroot) => '(a)
   (-> '(((a)) b c) seq-zip zdown zdown zdown zroot) => '(((a)) b c)
   (-> '() seq-zip zdown) => nil
   (-> (seq-zip '(a b c)) zdown zright znode) => 'b
@@ -68,6 +74,8 @@
   (-> '(a b c) seq-zip znode) => '(a b c)
   (-> '(a b c) seq-zip zdown zup znode) => '(a b c)
   (-> '(a b c) seq-zip zup) => nil
+  (-> '() seq-zip zroot) => '()
+  (-> '(a) seq-zip zroot) => '(a)
   (-> '(((a)) b c) seq-zip zdown zdown zdown zroot) => '(((a)) b c)
   (-> (seq-zip '(a b c)) zdown zright znode) => 'b
   (-> (seq-zip '(a b c)) zdown zup znode) => '(a b c)
@@ -136,8 +144,36 @@
   (let [z (-> (seq-zip '(a)) znext (zreplace 5) znext)]
     (zend? z) => truthy
     (zroot z) => '(5)))
-
-;;; =====
+
+(fact "old stuff still works"
+  (-> '(a b c) seq-zip zdown znode) => 'a
+  (-> '( (+ 1 2) 3 4) seq-zip zdown znode) => '(+ 1 2)
+  (-> '( (+ 1 2) 3 4) seq-zip zdown zdown znode) => '+
+  (-> '() seq-zip zdown) => nil
+  (-> '(a b c) seq-zip znode) => '(a b c)
+  (-> '(a b c) seq-zip zdown zup znode) => '(a b c)
+  (-> '(a b c) seq-zip zup) => nil
+  (-> '() seq-zip zroot) => '()
+  (-> '(a) seq-zip zroot) => '(a)
+  (-> '(((a)) b c) seq-zip zdown zdown zdown zroot) => '(((a)) b c)
+  (-> (seq-zip '(a b c)) zdown zright znode) => 'b
+  (-> (seq-zip '(a b c)) zdown zup znode) => '(a b c)
+  (-> (seq-zip '(a b c)) zdown zright zright zleft znode) => 'b
+  (-> (seq-zip '(a b c)) zdown zleft) => nil
+  (-> (seq-zip '(a b c)) zdown zright zright zright) => nil
+  (-> (seq-zip '(a)) zdown (zreplace 3) zup zup) => nil
+  (-> (seq-zip '(a b c)) zdown zright (zreplace 3) znode) => 3
+  (-> (seq-zip '(a b c)) zdown zright (zreplace 3) zright zleft znode) => 3
+  (-> (seq-zip '(a b c)) zdown zright (zreplace 3) zleft zright zright znode) => 'c
+  (-> (seq-zip '(a b c)) zdown zright (zreplace 3) zup znode) => '(a 3 c)
+  (-> (seq-zip '(a b c)) zdown zright (zreplace 3) zright (zreplace 4) zup znode) => '(a 3 4)
+  (-> (seq-zip '(a (b) c)) zdown zright zdown (zreplace 3) zroot) => '(a (3) c)
+  (-> (seq-zip '(a (b) c)) zdown zright zdown (zreplace 3) zup zright (zreplace 4) zroot) => '(a (3) 4))
+
+
+
+
+;;; Rerun tests from earlier in the chapter, using our homemade zippers.
 
 
 (def all-vectors