Repository: exercism/clojure
Pull request #538 (2023-03-12 12:47:45)

Add Zipper exercise


Patch:
diff --git a/config.json b/config.json
index 1ba1835..e508f9f 100644
--- a/config.json
+++ b/config.json
@@ -1001,6 +1001,17 @@
         "topics": [
           "conditionals"
         ]
+      },
+      {
+        "slug": "zipper",
+        "name": "Zipper",
+        "uuid": "331b2960-baae-4331-a462-a434fd6e8767",
+        "practices": [],
+        "prerequisites": ["strings", "vectors"],
+        "difficulty": 9,
+        "topics": [
+          "conditionals"
+        ]
       }
     ]
   },
diff --git a/exercises/practice/zipper/.docs/instructions.md b/exercises/practice/zipper/.docs/instructions.md
new file mode 100644
index 0000000..7ff8f67
--- /dev/null
+++ b/exercises/practice/zipper/.docs/instructions.md
@@ -0,0 +1,27 @@
+# Description
+
+Creating a zipper for a binary tree.
+
+[Zippers][zipper] are a purely functional way of navigating within a data structure and manipulating it.
+They essentially contain a data structure and a pointer into that data structure (called the focus).
+
+For example given a rose tree (where each node contains a value and a list of child nodes) a zipper might support these operations:
+
+- `from_tree` (get a zipper out of a rose tree, the focus is on the root node)
+- `to_tree` (get the rose tree out of the zipper)
+- `value` (get the value of the focus node)
+- `prev` (move the focus to the previous child of the same parent,
+  returns a new zipper)
+- `next` (move the focus to the next child of the same parent, returns a
+  new zipper)
+- `up` (move the focus to the parent, returns a new zipper)
+- `set_value` (set the value of the focus node, returns a new zipper)
+- `insert_before` (insert a new subtree before the focus node, it
+  becomes the `prev` of the focus node, returns a new zipper)
+- `insert_after` (insert a new subtree after the focus node, it becomes
+  the `next` of the focus node, returns a new zipper)
+- `delete` (removes the focus node and all subtrees, focus moves to the
+  `next` node if possible otherwise to the `prev` node if possible,
+  otherwise to the parent node, returns a new zipper)
+
+[zipper]: https://en.wikipedia.org/wiki/Zipper_%28data_structure%29
diff --git a/exercises/practice/zipper/.meta/config.json b/exercises/practice/zipper/.meta/config.json
new file mode 100644
index 0000000..7a564d0
--- /dev/null
+++ b/exercises/practice/zipper/.meta/config.json
@@ -0,0 +1,10 @@
+{
+  "authors" : [ "porkostomus" ],
+  "contributors" : [ ],
+  "files" : {
+    "solution" : [ "src/zipper.clj" ],
+    "test" : [ "test/zipper_test.clj" ],
+    "example" : [ ".meta/src/example.clj" ]
+  },
+  "blurb" : "Creating a zipper for a binary tree."
+}
\ No newline at end of file
diff --git a/exercises/practice/zipper/.meta/src/example.clj b/exercises/practice/zipper/.meta/src/example.clj
new file mode 100644
index 0000000..e8fab36
--- /dev/null
+++ b/exercises/practice/zipper/.meta/src/example.clj
@@ -0,0 +1,57 @@
+(ns zipper)
+
+(defn from-trail [tree last]
+  (if (= (nth last 0) "left")
+    {:value (nth last 1), :left tree, :right (nth last 2)}
+    {:value (nth last 1), :left (nth last 2), :right tree}))
+
+(defn from-tree [tree]
+  {:tree tree :trail []})
+
+(defn value [z]
+  (:value (:tree z)))
+
+(defn zipper [tree trail]
+  {:tree tree :trail trail})
+
+(defn left [z]
+  (when (:left (:tree z))
+    (zipper (:left (:tree z))
+            (conj [["left" (:value (:tree z)) (:right (:tree z))]]
+                  (:trail z)))))
+(defn right [z]
+  (when (:right (:tree z))
+    (zipper (:right (:tree z))
+            (conj [["right" (:value (:tree z)) (:left (:tree z))]]
+                  (:trail z)))))
+
+(defn rebuild-tree [tree trail]
+  (if (= 0 (count trail))
+    tree
+    (recur (from-trail tree (first trail)) (fnext trail))))
+
+(defn to-tree [z]
+  (rebuild-tree (:tree z) (:trail z)))
+
+(defn up [z]
+  (when-not (zero? (count (:trail z)))
+    (zipper (from-trail (:tree z) (first (:trail z)))
+            (fnext (:trail z)))))
+
+(defn set-value [z value]
+  (zipper {:value value,
+           :left  (:left (:tree z)),
+           :right (:right (:tree z))}
+          (:trail z)))
+
+(defn set-left [z left]
+  (zipper {:value (:value (:tree z)),
+           :left  left,
+           :right (:right (:tree z))}
+          (:trail z)))
+
+(defn set-right [z right]
+  (zipper {:value (:value (:tree z)),
+           :left  (:left (:tree z)),
+           :right right}
+          (:trail z)))
diff --git a/exercises/practice/zipper/deps.edn b/exercises/practice/zipper/deps.edn
new file mode 100644
index 0000000..561c3e2
--- /dev/null
+++ b/exercises/practice/zipper/deps.edn
@@ -0,0 +1,6 @@
+{:aliases {:test {:extra-paths ["test"]
+                 :extra-deps {io.github.cognitect-labs/test-runner 
+                              {:git/url "https://github.com/cognitect-labs/test-runner.git"
+                               :sha "705ad25bbf0228b1c38d0244a36001c2987d7337"}}
+                 :main-opts ["-m" "cognitect.test-runner"]
+                 :exec-fn cognitect.test-runner.api/test}}}
\ No newline at end of file
diff --git a/exercises/practice/zipper/project.clj b/exercises/practice/zipper/project.clj
new file mode 100644
index 0000000..eb902cc
--- /dev/null
+++ b/exercises/practice/zipper/project.clj
@@ -0,0 +1,4 @@
+(defproject zipper "0.1.0-SNAPSHOT"
+  :description "zipper exercise."
+  :url "https://github.com/exercism/clojure/tree/master/exercises/zipper"
+  :dependencies [[org.clojure/clojure "1.10.0"]])
diff --git a/exercises/practice/zipper/src/zipper.clj b/exercises/practice/zipper/src/zipper.clj
new file mode 100644
index 0000000..02ea0cc
--- /dev/null
+++ b/exercises/practice/zipper/src/zipper.clj
@@ -0,0 +1,28 @@
+(ns zipper)
+
+(defn from-tree [] 
+  )
+
+(defn value [] 
+  )
+
+(defn left []
+  )
+
+(defn right []
+  )
+
+(defn to-tree []
+  )
+
+(defn up []
+  )
+
+(defn set-value []
+  )
+
+(defn set-left []
+  )
+
+(defn set-right []
+  )
diff --git a/generator.clj b/generator.clj
new file mode 100644
index 0000000..3c97c75
--- /dev/null
+++ b/generator.clj
@@ -0,0 +1,140 @@
+#!/usr/bin/env bb
+
+(require '[cheshire.core :as json]
+         '[babashka.fs :as fs]
+         '[clojure.string :as str])
+
+(comment
+  (def slug "zipper"))
+
+(def data
+  (let [url "https://raw.githubusercontent.com/exercism/problem-specifications/main/exercises/"]
+    {:canonical-data (json/parse-string (slurp (str url "/" slug "/canonical-data.json")) true)
+     :description (slurp (str url "/" slug "/description.md"))
+     :metadata (slurp (str url "/" slug "/metadata.toml"))}))
+
+(second
+ (str/split (:metadata data) #"="))
+
+(defn get-meta 
+  "Returns a vector containing the exercise title and blurb"
+  [data]
+  (mapv last
+       (map #(map str/trim (str/split % #"="))
+            (str/split-lines (:metadata data)))))
+
+(defn init-deps [data]
+  (fs/create-dirs (fs/path "exercises" "practice"
+                           (:exercise (:canonical-data data)) "src"))
+  (spit (str (fs/file "exercises" "practice"
+                      (:exercise (:canonical-data data))
+                      "deps.edn"))
+        "{:aliases {:test {:extra-paths [\"test\"]
+                 :extra-deps {io.github.cognitect-labs/test-runner 
+                              {:git/url \"https://github.com/cognitect-labs/test-runner.git\"
+                               :sha \"705ad25bbf0228b1c38d0244a36001c2987d7337\"}}
+                 :main-opts [\"-m\" \"cognitect.test-runner\"]
+                 :exec-fn cognitect.test-runner.api/test}}}"))
+
+(defn init-lein [data]
+  (let [slug (:exercise (:canonical-data data))]
+    (spit (str (fs/file "exercises" "practice"
+                        (:exercise (:canonical-data data)) "project.clj"))
+          (str "(defproject " slug " \"0.1.0-SNAPSHOT\"
+  :description \"" slug " exercise.\"
+  :url \"https://github.com/exercism/clojure/tree/master/exercises/" slug "\"
+  :dependencies [[org.clojure/clojure \"1.10.0\"]])
+"))))
+
+(defn test-ns-form [data]
+  (str "(ns " (:exercise data) "-test
+  (:require [clojure.test :refer [deftest testing is]]\n             "
+       (:exercise data) "))\n\n"))
+
+(defn src-ns-form [data]
+  (str "(ns " (:exercise data) ")\n\n"))
+
+(defn testing-form [slug test-case]
+  (let [property (symbol (str slug "/" (:property test-case)))
+        input (:input test-case)
+        args (map #(get input %) (keys input))]
+    (str "  (testing \"" (:description test-case) "\"
+     (is (= " (:expected test-case) " "
+         (reverse (into (list property) args)) ")))")))
+
+(defn zipper-generator [slug test-case]
+  (let [input (:input test-case)
+        ops (for [op (:operations input)]
+              (if (contains? op :item)
+                (str "(zipper/" (:operation op) " "
+                     (if (nil? (:item op))
+                       "nil"
+                       (str (:item op))) ")")
+                (str "zipper/" (:operation op))))]
+    (str "  (testing \"" (:description test-case) "\"
+     (is (= " (if (nil? (:value (:expected test-case)))
+                "nil" (:value (:expected test-case))) " "
+         "\n         (-> " (:initialTree input) "\n           "
+         (apply str (interpose "\n           " ops)) "))))")))
+
+(defn testing-forms
+  "Outputs a sequence of the test cases for a given property name
+   given its name as a string and the canonical data."
+  [property data]
+  (let [test-cases (filter #(= property (:property %)) (:cases data))]
+    (map #(zipper-generator (:exercise data) %) test-cases)))
+
+(defn deftest-forms [data]
+  (for [property (distinct (map :property (:cases (:canonical-data data))))]
+    (str "(deftest " property "-test\n"
+         (apply str (interpose "\n"
+                               (testing-forms property (:canonical-data data))))
+         ")")))
+
+(defn init-tests [data]
+  #_(fs/create-dir (fs/path "exercises" "practice"
+                            (:exercise (:canonical-data data)) "test"))
+  (spit (str (fs/file "exercises" "practice"
+                      (:exercise (:canonical-data data)) "test"
+                      (str (str/replace (:exercise (:canonical-data data)) "-" "_")
+                           "_test.clj")))
+        (str (test-ns-form (:canonical-data data))
+             (apply str (interpose "\n\n"
+                                   (deftest-forms data))))))
+
+(defn init-src [data]
+  (spit (str (fs/file "exercises" "practice" (:exercise (:canonical-data data)) "src"
+                      (str (str/replace (:exercise (:canonical-data data))
+                                        "-" "_") ".clj")))
+        (str (src-ns-form (:canonical-data data))
+             (apply str (interpose "\n\n"
+                                   (for [property (distinct (map :property (:cases (:canonical-data data))))]
+                                     (str "(defn " property " []\n  )")))))))
+
+(defn init-description! [data]
+  (let [path ["exercises" "practice" (:exercise (:canonical-data data)) ".docs"]]
+    (when-not (fs/directory? (apply fs/path path))
+      (fs/create-dir (apply fs/path path))
+      (spit (str (apply fs/file (conj path "instructions.md")))
+            (:description data)))))
+
+(defn config [data author blurb]
+  (let [slug (:exercise (:canonical-data data))]
+    {:authors [author],
+     :contributors [],
+     :files {:solution [(str "src/" (str/replace slug "-" "_") ".clj")], 
+             :test [(str "test/" (str/replace slug "-" "_") "_test.clj")], 
+             :example [".meta/src/example.clj"]},
+     :blurb blurb}))
+
+(defn init-config! [data]
+  (let [path ["exercises" "practice" (:exercise (:canonical-data data)) ".meta"]]
+    (when-not (fs/directory? (apply fs/path path))
+   (fs/create-dirs (apply fs/path (conj path "src")))
+      (spit (str (apply fs/file (conj path "config.json")))
+            (json/generate-string (config data "porkostomus" (last (get-meta data)))
+                                  {:pretty true})))))
+
+(comment
+  (init-config! data)
+  )
\ No newline at end of file


Test patch:
diff --git a/exercises/practice/zipper/test/zipper_test.clj b/exercises/practice/zipper/test/zipper_test.clj
new file mode 100644
index 0000000..6d85100
--- /dev/null
+++ b/exercises/practice/zipper/test/zipper_test.clj
@@ -0,0 +1,192 @@
+(ns zipper-test
+  (:require [clojure.test :refer [deftest testing is run-tests]]
+             zipper))
+
+(def t1 {:value 1, :left {:value 2, :left nil, :right {:value 3, :left nil, :right nil}}, :right {:value 4, :left nil, :right nil}})
+
+(deftest expected-value-test
+  (let [tree {:value 1
+              :left  {:value 2
+                      :left  nil
+                      :right {:value 3
+                              :left  nil
+                              :right nil}}
+              :right {:value 4
+                      :left  nil
+                      :right nil}}]
+    (testing "data is retained"
+      (is (= tree (-> tree zipper/from-tree zipper/to-tree))))
+    (testing "left, right and value"
+      (is (= 3 (-> t1
+                   zipper/from-tree
+                   zipper/left
+                   zipper/right
+                   zipper/value
+                   ))))
+    (testing "dead end"
+      (is (nil? (-> tree
+                     zipper/from-tree
+                     zipper/left
+                     zipper/left))))
+    (testing "tree from deep focus"
+      (is (= tree (-> tree
+                      zipper/from-tree
+                      zipper/left
+                      zipper/right
+                      zipper/to-tree))))
+    (testing "traversing up from top"
+      (is (= nil 
+             (-> tree
+                 zipper/from-tree
+                 zipper/up))))
+    (testing "left, right, and up"
+      (is (= 3 
+             (-> tree
+                 zipper/from-tree
+                 zipper/left
+                 zipper/up
+                 zipper/right
+                 zipper/up
+                 zipper/left
+                 zipper/right
+                 zipper/value))))
+    (testing "test ability to descend multiple levels and return"
+      (is (= 1 
+             (-> tree
+                 zipper/from-tree
+                 zipper/left
+                 zipper/right
+                 zipper/up
+                 zipper/up
+                 zipper/value))))
+    (testing "set_value"
+      (is (= {:value 1
+              :left  {:value 5
+                      :left  nil
+                      :right {:value 3
+                              :left  nil
+                              :right nil}}
+              :right {:value 4
+                      :left  nil
+                      :right nil}} 
+             (-> tree
+                 zipper/from-tree
+                 zipper/left
+                 (zipper/set-value 5)
+                 zipper/to-tree))))
+    (testing "set_value after traversing up"
+      (is (= {:value 1
+              :left  {:value 5
+                      :left  nil
+                      :right {:value 3
+                              :left  nil
+                              :right nil}}
+              :right {:value 4
+                      :left  nil
+                      :right nil}} 
+             (-> tree
+                 zipper/from-tree
+                 zipper/left
+                 zipper/right
+                 zipper/up
+                 (zipper/set-value 5)
+                 zipper/to-tree))))
+    (testing "set_left with leaf"
+      (is (= {:value 1
+              :left  {:value 2
+                      :left  {:value 5
+                              :left  nil
+                              :right nil}
+                      :right {:value 3
+                              :left  nil
+                              :right nil}}
+              :right {:value 4
+                      :left  nil
+                      :right nil}} 
+             (-> tree
+                 zipper/from-tree
+                 zipper/left
+                 (zipper/set-left {:value 5
+                                   :left  nil
+                                   :right nil})
+                 zipper/to-tree))))
+    (testing "set_right with null"
+      (is (= {:value 1
+              :left  {:value 2
+                      :left  nil
+                      :right nil}
+              :right {:value 4
+                      :left  nil
+                      :right nil}} 
+             (-> tree
+                 zipper/from-tree
+                 zipper/left
+                 (zipper/set-right nil)
+                 zipper/to-tree))))
+    (testing "set_right with subtree"
+      (is (= {:value 1
+              :left  {:value 2
+                      :left  nil
+                      :right {:value 3
+                              :left  nil
+                              :right nil}}
+              :right {:value 6
+                      :left  {:value 7
+                              :left  nil
+                              :right nil}
+                      :right {:value 8
+                              :left  nil
+                              :right nil}}} 
+             (-> tree
+                 zipper/from-tree
+                 (zipper/set-right {:value 6
+                                    :left  {:value 7
+                                            :left  nil
+                                            :right nil}
+                                    :right {:value 8
+                                            :left  nil
+                                            :right nil}})
+                 zipper/to-tree))))
+    (testing "set_value on deep focus"
+      (is (= {:value 1
+              :left  {:value 2
+                      :left  nil
+                      :right {:value 5
+                              :left  nil
+                              :right nil}}
+              :right {:value 4
+                      :left  nil
+                      :right nil}} 
+             (-> tree
+                 zipper/from-tree
+                 zipper/left
+                 zipper/right
+                 (zipper/set-value 5)
+                 zipper/to-tree))))))
+
+(deftest sameResultFromOperations-test
+  (testing "different paths to same zipper"
+     (is (= (-> {:value 1
+                 :left  {:value 2
+                         :left  nil
+                         :right {:value 3
+                                 :left  nil
+                                 :right nil}}
+                 :right {:value 4
+                         :left  nil
+                         :right nil}}
+                zipper/from-tree
+                zipper/right)
+         (-> {:value 1
+              :left  {:value 2
+                      :left  nil
+                      :right {:value 3
+                              :left  nil
+                              :right nil}}
+              :right {:value 4
+                      :left  nil
+                      :right nil}}
+             zipper/from-tree
+             zipper/left
+             zipper/up
+             zipper/right)))))