├── .gitignore ├── README.md ├── deps.edn └── src └── specify_it ├── bst.clj ├── bst_common.clj ├── bst_spec.clj ├── bug1.clj ├── bug2.clj ├── bug3.clj ├── bug4.clj ├── bug5.clj └── reverse.clj /.gitignore: -------------------------------------------------------------------------------- 1 | .cpcache/ 2 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | Attempted translation of the QuickCheck properties in this paper: 2 | 3 | "How to specify it!" - John Hughes 4 | 5 | https://www.dropbox.com/s/tx2b84kae4bw1p4/paper.pdf?dl=0 6 | 7 | Into Clojure test.check properties. I recreated the first 5 bugs in the paper 8 | (and the test.check properties do fail on them) but got bored after that as they 9 | assumed an implementation of `union` that isn't as silly as mine. 10 | Run the properties by redefining the vars at the top of `bst-spec` to 11 | point to the implementation of your choice and running `check-props`. There's also a BST that passes all the tests 12 | in `bst`. It's stupidly slow. 13 | 14 | Would love some help in how to make the `bst-spec` namespace 15 | 16 | 1. have less boilerplate 17 | 2. be more idiomatic. 18 | 3. I couldn't figure out how to make properties that test shrinking as in the paper 19 | -------------------------------------------------------------------------------- /deps.edn: -------------------------------------------------------------------------------- 1 | {:deps 2 | { 3 | org.clojure/test.check {:mvn/version "0.10.0-RC1"} 4 | org.clojure/clojure {:mvn/version "1.10.1"}} 5 | :paths ["src"]} 6 | -------------------------------------------------------------------------------- /src/specify_it/bst.clj: -------------------------------------------------------------------------------- 1 | (ns specify-it.bst 2 | (:require [specify-it.bst-common :as common])) 3 | 4 | (defn find' [k-new t] 5 | (if (= t :leaf) 6 | :not-found 7 | (let [{:keys [l r k v]} t] 8 | (cond 9 | (= k-new k) v 10 | (< k-new k) (recur k-new l) 11 | :else (recur k-new r))))) 12 | 13 | (defn nil' [] :leaf) 14 | 15 | (defn insert' [k-new v t] 16 | (if (= t :leaf) 17 | {:l :leaf :r :leaf :k k-new :v v} 18 | (let [{:keys [l r k]} t] 19 | (when (= nil k) 20 | (println t)) 21 | (cond 22 | (= k-new k) (assoc t :v v) 23 | (< k-new k) (assoc t :l (insert' k-new v l)) 24 | :else (assoc t :r (insert' k-new v r)))))) 25 | 26 | 27 | (defn union' [t1 t2] 28 | (reduce (fn [t [k v]] (insert' k v t)) t2 (common/insertions t1))) 29 | 30 | (defn delete' [k-new t] 31 | (if (= t :leaf) 32 | :leaf 33 | (let [{:keys [l r k]} t] 34 | (cond 35 | (= k-new k) (union' l r) 36 | (< k-new k) (assoc t :l (delete' k-new l)) 37 | :else (assoc t :r (delete' k-new r)))))) 38 | 39 | (defn keys' [t] 40 | (map first (common/insertions t))) 41 | 42 | (defn valid' [t] 43 | (if (= :leaf t) 44 | true 45 | (let [{:keys [l r k v]} t] 46 | (and 47 | (valid' l) 48 | (valid' r) 49 | (every? #(< % k) (keys' l)) 50 | (every? #(> % k) (keys' r)))))) 51 | -------------------------------------------------------------------------------- /src/specify_it/bst_common.clj: -------------------------------------------------------------------------------- 1 | (ns specify-it.bst-common) 2 | 3 | 4 | (defn insertions [t] 5 | (if (= t :leaf) 6 | [] 7 | (let [{:keys [l r k v]} t] 8 | (into [[k v]] (into (insertions l) (insertions r)))))) 9 | 10 | (defn to-sorted-list' [t] 11 | (sort (insertions t))) 12 | -------------------------------------------------------------------------------- /src/specify_it/bst_spec.clj: -------------------------------------------------------------------------------- 1 | (ns specify-it.bst-spec 2 | (:require [clojure.test.check :as tc] 3 | [clojure.test.check.generators :as gen] 4 | [clojure.test.check.properties :as prop] 5 | [clojure.test.check.clojure-test :as test] 6 | [specify-it.bst :as bst] 7 | [specify-it.bug2 :as bug1] 8 | [specify-it.bug2 :as bug2] 9 | [specify-it.bug3 :as bug3] 10 | [specify-it.bug3 :as bug4] 11 | [specify-it.bug3 :as bug5] 12 | [clojure.pprint :as pprint] 13 | [specify-it.bst-common :as common])) 14 | 15 | (def insert' bst/insert') 16 | (def nil' bst/nil') 17 | (def valid' bst/valid') 18 | (def find' bst/find') 19 | (def delete' bst/delete') 20 | (def union' bst/union') 21 | (def keys' bst/keys') 22 | 23 | (def to-sorted-list' common/to-sorted-list') 24 | (def insertions common/insertions) 25 | 26 | (defn equiv [t1 t2] (= (to-sorted-list' t1) (to-sorted-list' t2))) 27 | 28 | (defn prop-nil-valid [] (valid' (nil'))) 29 | (defn prop-insert-valid [k v t] (valid' (insert' k v t))) 30 | (defn prop-delete-valid [k t] (valid' (delete' k t))) 31 | (defn prop-union-valid [t t'] (valid' (union' t t'))) 32 | (defn prop-arbitrary-valid [t] (valid' t)) 33 | 34 | (defn prop-insert-post [k v t k'] 35 | (= (find' k' (insert' k v t)) 36 | (if (= k k') 37 | v 38 | (find' k' t)))) 39 | 40 | (defn prop-insert-post-same-key [k v t] 41 | (prop-insert-post k v t k)) 42 | 43 | (defn prop-union-post [t t' k] 44 | (let [r (find' k (union' t t'))] 45 | (or 46 | (= (find' k t) r) 47 | (= (find' k t') r)))) 48 | 49 | (defn prop-find-post-present [k v t] 50 | (= v 51 | (find' k (insert' k v t)))) 52 | 53 | (defn prop-find-post-absent [k t] 54 | (= :not-found 55 | (find' k (delete' k t)))) 56 | 57 | (defn prop-insert-delete-complete [k t] 58 | (if (= :not-found (find' k t)) 59 | (= t (delete' k t)) 60 | (= t (insert' k (find' k t) t)))) 61 | 62 | (defn prop-insert-insert [k v k' v' t] 63 | (equiv 64 | (insert' k v (insert' k' v' t)) 65 | (if (= k k') 66 | (insert' k v t) 67 | (insert' k' v' (insert' k v t))))) 68 | 69 | (defn prop-insert-insert-weak [k v k' v' t] 70 | (or (= k k') 71 | (equiv (insert' k v (insert' k' v' t)) (insert' k' v' (insert' k v t))))) 72 | 73 | (defn prop-insert-delete [k v k' t] 74 | (equiv 75 | (insert' k v (delete' k' t)) 76 | (if (= k k') 77 | (insert' k v t) 78 | (delete' k' (insert' k v t))))) 79 | 80 | (defn prop-insert-union [k v t t'] 81 | (equiv 82 | (insert' k v (union' t t')) 83 | (union' (insert' k v t) t'))) 84 | 85 | (defn prop-insert-preserves-equiv [k v equiv-t equiv-t'] 86 | (equiv 87 | (insert' k v equiv-t) 88 | (insert' k v equiv-t'))) 89 | 90 | (defn prop-delete-preserves-equiv [k equiv-t equiv-t'] 91 | (equiv 92 | (delete' k equiv-t) 93 | (delete' k equiv-t'))) 94 | 95 | (defn prop-union-preserves-equiv [equiv-t equiv-t'] 96 | (equiv 97 | (union' equiv-t equiv-t') 98 | (union' equiv-t' equiv-t))) 99 | 100 | (defn prop-find-preserves-equiv [k equiv-t equiv-t'] 101 | (= 102 | (find' k equiv-t) 103 | (find' k equiv-t'))) 104 | 105 | (defn prop-union-nil [t] 106 | (= t (union' (nil') t))) 107 | 108 | (defn prop-union-insert [t t' k v] 109 | (equiv 110 | (union' (insert' k v t) t') 111 | (insert' k v (union' t t')))) 112 | 113 | (defn prop-insert-complete [t] 114 | (= t 115 | (reduce (fn [t [k v]] (insert' k v t)) (nil') (insertions t)))) 116 | 117 | (defn prop-insert-complete-for-delete [k t] 118 | (prop-insert-complete (delete' k t))) 119 | 120 | (defn prop-insert-complete-for-union [t t'] 121 | (prop-insert-complete (union' t t'))) 122 | 123 | (defn prop-nil-model [] 124 | (= (to-sorted-list' (nil')) [])) 125 | 126 | (defn prop-insert-model [k v t] 127 | (= 128 | (to-sorted-list' (insert' k v t)) 129 | (into [] (assoc (dissoc (into (sorted-map) (insertions t)) k) k v)))) 130 | 131 | (defn prop-delete-model [k t] 132 | (= 133 | (to-sorted-list' (delete' k t)) 134 | (into [] (dissoc (into (sorted-map) (insertions t)) k)))) 135 | 136 | (defn prop-union-model [t t'] 137 | (to-sorted-list' (union' t t')) 138 | (into [] (merge (into (sorted-map) (insertions t)) (into (sorted-map) (insertions t'))))) 139 | 140 | (defn prop-find-model [k t] 141 | (= 142 | (find' k t) 143 | (get (into (sorted-map) (insertions t)) k :not-found))) 144 | 145 | (def key-gen (gen/scale #(/ % 2) gen/nat)) 146 | 147 | (def tree-gen 148 | (gen/fmap 149 | (fn [kvs] 150 | (reduce (fn [t [k v]] (insert' k v t)) (nil') kvs)) 151 | (gen/vector (gen/tuple key-gen gen/nat)))) 152 | 153 | (def equiv-tree-gen (gen/such-that #(equiv (first %) (second %)) 154 | (gen/fmap 155 | (fn [kvs] 156 | [ 157 | (reduce (fn [t [k v]] (insert' k v t)) (nil') kvs) 158 | (reduce (fn [t [k v]] (insert' k v t)) (nil') (shuffle kvs))]) 159 | (gen/vector (gen/tuple gen/large-integer gen/nat))))) 160 | 161 | 162 | (def labels (atom {})) 163 | (defn label! [ks lbl] 164 | (swap! labels update-in (conj ks lbl) #(inc (or % 0)))) 165 | 166 | (def props-with-bound-generators 167 | { 168 | :prop-nil-valid (prop/for-all* [] prop-nil-valid) 169 | :prop-insert-valid (prop/for-all [k key-gen 170 | v gen/large-integer 171 | t tree-gen] 172 | (prop-insert-valid k v t)) 173 | :prop-delete-valid (prop/for-all [k key-gen 174 | t tree-gen] 175 | (prop-delete-valid k t)) 176 | :prop-union-valid (prop/for-all [t1 tree-gen 177 | t2 tree-gen] 178 | (prop-union-valid t1 t2)) 179 | :prop-arbitrary-valid (prop/for-all [t tree-gen] 180 | (prop-arbitrary-valid t)) 181 | :prop-insert-post (prop/for-all [k key-gen 182 | v gen/large-integer 183 | t tree-gen 184 | k' gen/large-integer] 185 | (prop-insert-post k v t k')) 186 | :prop-insert-post-same-key (prop/for-all [k key-gen 187 | v gen/large-integer 188 | t tree-gen] 189 | (prop-insert-post-same-key k v t)) 190 | :prop-union-post (prop/for-all [t tree-gen 191 | t' tree-gen 192 | k key-gen] 193 | (prop-union-post t t' k)) 194 | :prop-find-post-present (prop/for-all [k key-gen 195 | v gen/large-integer 196 | t tree-gen] 197 | (prop-find-post-present k v t)) 198 | :prop-find-post-absent (prop/for-all [k key-gen 199 | t tree-gen] 200 | (prop-find-post-absent k t)) 201 | :prop-insert-delete-complete (prop/for-all [k key-gen 202 | t tree-gen] 203 | (prop-insert-delete-complete k t)) 204 | :prop-insert-insert (prop/for-all [k key-gen 205 | v gen/large-integer 206 | k' key-gen 207 | v' gen/large-integer 208 | t tree-gen] 209 | (prop-insert-insert k v k' v' t)) 210 | :prop-insert-insert-weak (prop/for-all [[k k'] (gen/such-that #(not= (first %) (second %)) (gen/tuple key-gen key-gen)) 211 | v gen/large-integer 212 | v' gen/large-integer 213 | t tree-gen] 214 | (prop-insert-insert-weak k v k' v' t)) 215 | :prop-insert-delete (prop/for-all [k key-gen 216 | v gen/large-integer 217 | k' key-gen 218 | t tree-gen] 219 | (prop-insert-delete k v k' t)) 220 | :prop-insert-union (prop/for-all [k key-gen 221 | v gen/large-integer 222 | t tree-gen 223 | t' tree-gen] 224 | (prop-insert-union k v t t')) 225 | :prop-insert-preserves-equiv (prop/for-all [k key-gen 226 | v gen/large-integer 227 | [equiv-t equiv-t'] equiv-tree-gen] 228 | (prop-insert-preserves-equiv k v equiv-t equiv-t')) 229 | :prop-delete-preserves-equiv (prop/for-all [k key-gen 230 | [equiv-t equiv-t'] equiv-tree-gen] 231 | (prop-delete-preserves-equiv k equiv-t equiv-t')) 232 | :prop-union-preserves-equiv (prop/for-all [[equiv-t equiv-t'] equiv-tree-gen] 233 | (prop-union-preserves-equiv equiv-t equiv-t')) 234 | :prop-find-preserves-equiv (prop/for-all [k gen/large-integer 235 | [equiv-t equiv-t'] equiv-tree-gen] 236 | (prop-find-preserves-equiv k equiv-t equiv-t')) 237 | :prop-equivs (prop/for-all [[equiv-t equiv-t'] equiv-tree-gen] 238 | (equiv equiv-t equiv-t')) 239 | :prop-union-nil (prop/for-all [t tree-gen] 240 | (prop-union-nil t)) 241 | :prop-union-insert (prop/for-all [t tree-gen 242 | t' tree-gen 243 | k key-gen 244 | v gen/large-integer] 245 | (prop-union-insert t t' k v)) 246 | :prop-insert-complete (prop/for-all [t tree-gen] 247 | (prop-insert-complete t)) 248 | :prop-insert-complete-for-delete (prop/for-all [k key-gen 249 | t tree-gen] 250 | (prop-insert-complete-for-delete k t)) 251 | :prop-insert-complete-for-union (prop/for-all [t tree-gen 252 | t' tree-gen] 253 | (prop-insert-complete-for-union t t')) 254 | :prop-nil-model (prop/for-all [] (prop-nil-model)) 255 | :prop-insert-model (prop/for-all [k key-gen 256 | v gen/large-integer 257 | t tree-gen] 258 | (prop-insert-model k v t)) 259 | :prop-delete-model (prop/for-all [k key-gen 260 | t tree-gen] 261 | (prop-delete-model k t)) 262 | :prop-union-model (prop/for-all [t tree-gen 263 | t' tree-gen] 264 | (prop-union-model t t')) 265 | :prop-find-model (prop/for-all [k key-gen 266 | t tree-gen] 267 | (prop-find-model k t)) 268 | :prop-measure (prop/for-all [k key-gen 269 | t tree-gen] 270 | 271 | (if ((set (keys' t)) k) 272 | (label! [:prop-measure :presence] "present") 273 | (label! [:prop-measure :presence] "absent")) 274 | (cond 275 | (= nil k) (label! [:prop-measure :location] "empty") 276 | (= (keys' t) [k]) (label! [:prop-measure :location] "just k") 277 | (every? #(>= % k) (keys' t)) (label! [:prop-measure :location] "at start") 278 | (every? #(<= % k) (keys' t)) (label! [:prop-measure :location] "at end") 279 | :else (label! [:prop-measure :location] "middle")) 280 | true)}) 281 | 282 | (defn report! [] 283 | (doseq [[property measurements] @labels] 284 | (println (str property ":")) 285 | (doseq [[measurement labels] measurements] 286 | (println (str "\t" measurement ":")) 287 | (let [total (apply + (vals labels))] 288 | (doseq [[label num] labels] 289 | (println (str "\t\t" label ":" (* 100 (/ (double num) total)) "%"))))))) 290 | 291 | 292 | (defn check-props [] 293 | (reset! labels {}) 294 | (doseq [[prop-name prop] props-with-bound-generators] 295 | (let [result (tc/quick-check 100 prop)] 296 | (if (:pass? result) 297 | (println {:prop-name prop-name :pass? true}) 298 | (pprint/pprint [prop-name result])))) 299 | (report!)) 300 | 301 | (check-props) 302 | 303 | -------------------------------------------------------------------------------- /src/specify_it/bug1.clj: -------------------------------------------------------------------------------- 1 | (ns specify-it.bug1 2 | (:require [specify-it.bst-common :as common])) 3 | 4 | (defn find' [k-new t] 5 | (if (= t :leaf) 6 | :not-found 7 | (let [{:keys [l r k v]} t] 8 | (cond 9 | (= k-new k) v 10 | (< k-new k) (recur k-new l) 11 | :else (recur k-new r))))) 12 | 13 | (defn nil' [] :leaf) 14 | 15 | (defn insert' [k-new v t] 16 | {:l :leaf :r :leaf :k k-new :v v}) 17 | 18 | 19 | (defn union' [t1 t2] 20 | (reduce (fn [t [k v]] (insert' k v t)) t2 (common/insertions t1))) 21 | 22 | (defn delete' [k-new t] 23 | (if (= t :leaf) 24 | :leaf 25 | (let [{:keys [l r k]} t] 26 | (cond 27 | (= k-new k) (union' l r) 28 | (< k-new k) (assoc t :l (delete' k-new l)) 29 | :else (assoc t :r (delete' k-new r)))))) 30 | 31 | (defn keys' [t] 32 | (map first (common/insertions t))) 33 | 34 | (defn valid' [t] 35 | (if (= :leaf t) 36 | true 37 | (let [{:keys [l r k v]} t] 38 | (and 39 | (valid' l) 40 | (valid' r) 41 | (every? #(< % k) (keys' l)) 42 | (every? #(> % k) (keys' r)))))) 43 | -------------------------------------------------------------------------------- /src/specify_it/bug2.clj: -------------------------------------------------------------------------------- 1 | (ns specify-it.bug2 2 | (:require [specify-it.bst-common :as common])) 3 | 4 | (defn find' [k-new t] 5 | (if (= t :leaf) 6 | :not-found 7 | (let [{:keys [l r k v]} t] 8 | (cond 9 | (= k-new k) v 10 | (< k-new k) (recur k-new l) 11 | :else (recur k-new r))))) 12 | 13 | (defn nil' [] :leaf) 14 | 15 | (defn insert' [k-new v t] 16 | (if (= t :leaf) 17 | {:l :leaf :r :leaf :k k-new :v v} 18 | (let [{:keys [l r k]} t] 19 | (when (= nil k) 20 | (println t)) 21 | (cond 22 | (< k-new k) (assoc t :l (insert' k-new v l)) 23 | :else (assoc t :r (insert' k-new v r)))))) 24 | 25 | 26 | (defn union' [t1 t2] 27 | (reduce (fn [t [k v]] (insert' k v t)) t2 (common/insertions t1))) 28 | 29 | (defn delete' [k-new t] 30 | (if (= t :leaf) 31 | :leaf 32 | (let [{:keys [l r k]} t] 33 | (cond 34 | (= k-new k) (union' l r) 35 | (< k-new k) (assoc t :l (delete' k-new l)) 36 | :else (assoc t :r (delete' k-new r)))))) 37 | 38 | (defn keys' [t] 39 | (map first (common/insertions t))) 40 | 41 | (defn valid' [t] 42 | (if (= :leaf t) 43 | true 44 | (let [{:keys [l r k v]} t] 45 | (and 46 | (valid' l) 47 | (valid' r) 48 | (every? #(< % k) (keys' l)) 49 | (every? #(> % k) (keys' r)))))) 50 | -------------------------------------------------------------------------------- /src/specify_it/bug3.clj: -------------------------------------------------------------------------------- 1 | (ns specify-it.bug3 2 | (:require [specify-it.bst-common :as common])) 3 | 4 | (defn find' [k-new t] 5 | (if (= t :leaf) 6 | :not-found 7 | (let [{:keys [l r k v]} t] 8 | (cond 9 | (= k-new k) v 10 | (< k-new k) (recur k-new l) 11 | :else (recur k-new r))))) 12 | 13 | (defn nil' [] :leaf) 14 | 15 | (defn insert' [k-new v t] 16 | (if (= t :leaf) 17 | {:l :leaf :r :leaf :k k-new :v v} 18 | (let [{:keys [l r k]} t] 19 | (when (= nil k) 20 | (println t)) 21 | (cond 22 | (= k-new k) t 23 | (< k-new k) (assoc t :l (insert' k-new v l)) 24 | :else (assoc t :r (insert' k-new v r)))))) 25 | 26 | 27 | (defn union' [t1 t2] 28 | (reduce (fn [t [k v]] (insert' k v t)) t2 (common/insertions t1))) 29 | 30 | (defn delete' [k-new t] 31 | (if (= t :leaf) 32 | :leaf 33 | (let [{:keys [l r k]} t] 34 | (cond 35 | (= k-new k) (union' l r) 36 | (< k-new k) (assoc t :l (delete' k-new l)) 37 | :else (assoc t :r (delete' k-new r)))))) 38 | 39 | (defn keys' [t] 40 | (map first (common/insertions t))) 41 | 42 | (defn valid' [t] 43 | (if (= :leaf t) 44 | true 45 | (let [{:keys [l r k v]} t] 46 | (and 47 | (valid' l) 48 | (valid' r) 49 | (every? #(< % k) (keys' l)) 50 | (every? #(> % k) (keys' r)))))) 51 | -------------------------------------------------------------------------------- /src/specify_it/bug4.clj: -------------------------------------------------------------------------------- 1 | (ns specify-it.bug4 2 | (:require [specify-it.bst-common :as common])) 3 | 4 | (defn find' [k-new t] 5 | (if (= t :leaf) 6 | :not-found 7 | (let [{:keys [l r k v]} t] 8 | (cond 9 | (= k-new k) v 10 | (< k-new k) (recur k-new l) 11 | :else (recur k-new r))))) 12 | 13 | (defn nil' [] :leaf) 14 | 15 | (defn insert' [k-new v t] 16 | (if (= t :leaf) 17 | {:l :leaf :r :leaf :k k-new :v v} 18 | (let [{:keys [l r k]} t] 19 | (when (= nil k) 20 | (println t)) 21 | (cond 22 | (= k-new k) (assoc t :v v) 23 | (< k-new k) (assoc t :l (insert' k-new v l)) 24 | :else (assoc t :r (insert' k-new v r)))))) 25 | 26 | 27 | (defn union' [t1 t2] 28 | (reduce (fn [t [k v]] (insert' k v t)) t2 (common/insertions t1))) 29 | 30 | (defn delete' [k-new t] 31 | (if (= t :leaf) 32 | :leaf 33 | (let [{:keys [l r k]} t] 34 | (cond 35 | (= k-new k) (union' l r) 36 | (< k-new k) (delete' k-new l) 37 | :else (delete' k-new r))))) 38 | 39 | (defn keys' [t] 40 | (map first (common/insertions t))) 41 | 42 | (defn valid' [t] 43 | (if (= :leaf t) 44 | true 45 | (let [{:keys [l r k v]} t] 46 | (and 47 | (valid' l) 48 | (valid' r) 49 | (every? #(< % k) (keys' l)) 50 | (every? #(> % k) (keys' r)))))) 51 | -------------------------------------------------------------------------------- /src/specify_it/bug5.clj: -------------------------------------------------------------------------------- 1 | (ns specify-it.bug5 2 | (:require [specify-it.bst-common :as common])) 3 | 4 | (defn find' [k-new t] 5 | (if (= t :leaf) 6 | :not-found 7 | (let [{:keys [l r k v]} t] 8 | (cond 9 | (= k-new k) v 10 | (< k-new k) (recur k-new l) 11 | :else (recur k-new r))))) 12 | 13 | (defn nil' [] :leaf) 14 | 15 | (defn insert' [k-new v t] 16 | (if (= t :leaf) 17 | {:l :leaf :r :leaf :k k-new :v v} 18 | (let [{:keys [l r k]} t] 19 | (when (= nil k) 20 | (println t)) 21 | (cond 22 | (= k-new k) (assoc t :v v) 23 | (< k-new k) (assoc t :l (insert' k-new v l)) 24 | :else (assoc t :r (insert' k-new v r)))))) 25 | 26 | 27 | (defn union' [t1 t2] 28 | (reduce (fn [t [k v]] (insert' k v t)) t2 (common/insertions t1))) 29 | 30 | (defn delete' [k-new t] 31 | (if (= t :leaf) 32 | :leaf 33 | (let [{:keys [l r k]} t] 34 | (cond 35 | (= k-new k) (union' l r) 36 | (> k-new k) (assoc t :l (delete' k-new l)) 37 | :else (assoc t :r (delete' k-new r)))))) 38 | 39 | (defn keys' [t] 40 | (map first (common/insertions t))) 41 | 42 | (defn valid' [t] 43 | (if (= :leaf t) 44 | true 45 | (let [{:keys [l r k v]} t] 46 | (and 47 | (valid' l) 48 | (valid' r) 49 | (every? #(< % k) (keys' l)) 50 | (every? #(> % k) (keys' r)))))) 51 | -------------------------------------------------------------------------------- /src/specify_it/reverse.clj: -------------------------------------------------------------------------------- 1 | (ns specify-it.reverse 2 | (:require [clojure.test.check :as tc] 3 | [clojure.test.check.generators :as gen] 4 | [clojure.test.check.properties :as prop])) 5 | 6 | (defn test-reverse [] 7 | (= (reverse [1 2 3]) [3 2 1])) 8 | 9 | (test-reverse) 10 | ;; true 11 | 12 | (comment 13 | (def prop-reverse 14 | (prop/for-all [xs (gen/vector gen/small-integer)] 15 | (= (reverse xs) ??)))) 16 | 17 | (comment 18 | (def prop-reverse 19 | (prop/for-all [xs (gen/vector gen/small-integer)] 20 | (= (reverse xs) (predict-rev xs))))) 21 | 22 | (def prop-reverse 23 | (prop/for-all [xs (gen/vector gen/large-integer)] 24 | (= (reverse (reverse xs)) xs))) 25 | 26 | (tc/quick-check 100 prop-reverse) 27 | ;; {:result true, :pass? true, :num-tests 100, :time-elapsed-ms 18, :seed 1563381856511} 28 | 29 | (defn reverse' [xs] 30 | xs) 31 | 32 | (def prop-reverse' 33 | (prop/for-all [xs (gen/vector gen/large-integer)] 34 | (= (reverse' (reverse' xs)) xs))) 35 | 36 | (tc/quick-check 100 prop-reverse') 37 | ;; {:result true, :pass? true, :num-tests 100, :time-elapsed-ms 17, :seed 1563381877360} 38 | 39 | (def prop-wrong 40 | (prop/for-all [xs (gen/vector gen/large-integer)] 41 | (= (reverse xs) xs))) 42 | 43 | (tc/quick-check 100 prop-wrong) 44 | ;; {:shrunk {:total-nodes-visited 7, :depth 1, :pass? false, :result false, :result-data nil, :time-shrinking-ms 1, :smallest [[0 -1]]}, :failed-after-ms 0, :num-tests 3, :seed 1563381885459, :fail [[-2 -1]], :result false, :result-data nil, :failing-size 2, :pass? false} 45 | --------------------------------------------------------------------------------