Codebase list test-check-clojure / ec5d502
rose_tree.{[clj cljs] -> cljc} Nicolas Berger authored 8 years ago Gary Fredericks committed 8 years ago
6 changed file(s) with 192 addition(s) and 386 deletion(s). Raw diff Collapse all Expand all
+0
-158
src/main/clojure/clojure/test/check/rose_tree.clj less more
0 (ns clojure.test.check.rose-tree
1 "A lazy tree data structure used for shrinking."
2 (:refer-clojure :exclude [filter remove seq])
3 (:require [clojure.core :as core]))
4
5 (deftype RoseTree [root children]
6 clojure.lang.Indexed
7 (nth [this i]
8 (cond (= i 0) root
9 (= i 1) children
10 :else (throw (IndexOutOfBoundsException.))))
11
12 (nth [this i not-found]
13 (cond (= i 0) root
14 (= i 1) children
15 :else not-found)))
16
17 (defn make-rose [root children]
18 (RoseTree. root children))
19
20 (defn- exclude-nth
21 "Exclude the nth value in a collection."
22 [n coll]
23 (lazy-seq
24 (when-let [s (core/seq coll)]
25 (if (zero? n)
26 (rest coll)
27 (cons (first s)
28 (exclude-nth (dec n) (rest s)))))))
29
30 (defn join
31 "Turn a tree of trees into a single tree. Does this by concatenating
32 children of the inner and outer trees."
33 {:no-doc true}
34 [[[inner-root inner-children] children]]
35 (make-rose
36 inner-root
37 (concat (map join children)
38 inner-children)))
39
40 (defn root
41 "Returns the root of a Rose tree."
42 {:no-doc true}
43 [tree]
44 (nth tree 0))
45
46 (defn children
47 "Returns the children of the root of the Rose tree."
48 {:no-doc true}
49 [tree]
50 (nth tree 1))
51
52 (defn pure
53 "Puts a value `x` into a Rose tree, with no children."
54 {:no-doc true}
55 [x]
56 (make-rose x []))
57
58 (defn fmap
59 "Applies functions `f` to all values in the tree."
60 {:no-doc true}
61 [f [root children]]
62 (make-rose (f root) (map (partial fmap f) children)))
63
64 (defn bind
65 "Takes a Rose tree (m) and a function (k) from
66 values to Rose tree and returns a new Rose tree.
67 This is the monadic bind (>>=) for Rose trees."
68 {:no-doc true}
69 [m k]
70 (join (fmap k m)))
71
72 (defn filter
73 "Returns a new Rose tree whose values pass `pred`. Values who
74 do not pass `pred` have their children cut out as well.
75 Takes a list of roses, not a rose"
76 {:no-doc true}
77 [pred [the-root children]]
78 (make-rose
79 the-root
80 (map (partial filter pred)
81 (core/filter (comp pred root) children))))
82
83 (defn permutations
84 "Create a seq of vectors, where each rose in turn, has been replaced
85 by its children."
86 {:no-doc true}
87 [roses]
88 (apply concat
89 (for [[rose index]
90 (map vector roses (range))]
91 (for [child (children rose)] (assoc roses index child)))))
92
93 (defn zip
94 "Apply `f` to the sequence of Rose trees `roses`."
95 {:no-doc true}
96 [f roses]
97 (make-rose
98 (apply f (map root roses))
99 (map (partial zip f)
100 (permutations roses))))
101
102 (defn remove
103 {:no-doc true}
104 [roses]
105 (concat
106 (map-indexed (fn [index _] (exclude-nth index roses)) roses)
107 (permutations (vec roses))))
108
109 (defn shrink
110 {:no-doc true}
111 [f roses]
112 (if (core/seq roses)
113 (make-rose (apply f (map root roses))
114 (map (partial shrink f) (remove roses)))
115 (make-rose (f) [])))
116
117 (defn collapse
118 "Return a new rose-tree whose depth-one children
119 are the children from depth one _and_ two of the input
120 tree."
121 {:no-doc true}
122 [[root the-children]]
123 (make-rose
124 root
125 (concat (map collapse the-children)
126 (map collapse
127 (mapcat children the-children)))))
128
129 (defn- make-stack
130 [children stack]
131 (if-let [s (core/seq children)]
132 (cons children stack)
133 stack))
134
135 (defn seq
136 "Create a lazy-seq of all of the (unique) nodes in a shrink-tree.
137 This assumes that two nodes with the same value have the same children.
138 While it's not common, it's possible to create trees that don't
139 fit that description. This function is significantly faster than
140 brute-force enumerating all of the nodes in a tree, as there will
141 be many duplicates."
142 [root]
143 (let [helper (fn helper [[node children] seen stack]
144 (lazy-seq
145 (if-not (seen node)
146 (cons node
147 (if (core/seq children)
148 (helper (first children) (conj seen node) (make-stack (rest children) stack))
149 (when-let [s (core/seq stack)]
150 (let [f (ffirst s)
151 r (rest (first s))]
152 (helper f (conj seen node) (make-stack r (rest s)))))))
153 (when-let [s (core/seq stack)]
154 (let [f (ffirst s)
155 r (rest (first s))]
156 (helper f seen (make-stack r (rest s))))))))]
157 (helper root #{} '())))
+160
-0
src/main/clojure/clojure/test/check/rose_tree.cljc less more
0 (ns clojure.test.check.rose-tree
1 "A lazy tree data structure used for shrinking."
2 (:refer-clojure :exclude [filter remove seq])
3 (:require [#?(:clj clojure.core :cljs cljs.core) :as core]))
4
5 (deftype RoseTree [root children]
6 #?(:clj clojure.lang.Indexed
7 :cljs IIndexed)
8 (#?(:clj nth :cljs -nth) [this i]
9 (cond (= i 0) root
10 (= i 1) children
11 :else (throw #?(:clj (IndexOutOfBoundsException.)
12 :cljs (js/Error. "Index out of bounds in rose tree")))))
13
14 (#?(:clj nth :cljs -nth) [this i not-found]
15 (cond (= i 0) root
16 (= i 1) children
17 :else not-found)))
18
19 (defn make-rose [root children]
20 (RoseTree. root children))
21
22 (defn- exclude-nth
23 "Exclude the nth value in a collection."
24 [n coll]
25 (lazy-seq
26 (when-let [s (core/seq coll)]
27 (if (zero? n)
28 (rest coll)
29 (cons (first s)
30 (exclude-nth (dec n) (rest s)))))))
31
32 (defn join
33 "Turn a tree of trees into a single tree. Does this by concatenating
34 children of the inner and outer trees."
35 {:no-doc true}
36 [[[inner-root inner-children] children]]
37 (make-rose
38 inner-root
39 (concat (map join children)
40 inner-children)))
41
42 (defn root
43 "Returns the root of a Rose tree."
44 {:no-doc true}
45 [tree]
46 (nth tree 0))
47
48 (defn children
49 "Returns the children of the root of the Rose tree."
50 {:no-doc true}
51 [tree]
52 (nth tree 1))
53
54 (defn pure
55 "Puts a value `x` into a Rose tree, with no children."
56 {:no-doc true}
57 [x]
58 (make-rose x []))
59
60 (defn fmap
61 "Applies functions `f` to all values in the tree."
62 {:no-doc true}
63 [f [root children]]
64 (make-rose (f root) (map (partial fmap f) children)))
65
66 (defn bind
67 "Takes a Rose tree (m) and a function (k) from
68 values to Rose tree and returns a new Rose tree.
69 This is the monadic bind (>>=) for Rose trees."
70 {:no-doc true}
71 [m k]
72 (join (fmap k m)))
73
74 (defn filter
75 "Returns a new Rose tree whose values pass `pred`. Values who
76 do not pass `pred` have their children cut out as well.
77 Takes a list of roses, not a rose"
78 {:no-doc true}
79 [pred [the-root children]]
80 (make-rose
81 the-root
82 (map (partial filter pred)
83 (core/filter (comp pred root) children))))
84
85 (defn permutations
86 "Create a seq of vectors, where each rose in turn, has been replaced
87 by its children."
88 {:no-doc true}
89 [roses]
90 (apply concat
91 (for [[rose index]
92 (map vector roses (range))]
93 (for [child (children rose)] (assoc roses index child)))))
94
95 (defn zip
96 "Apply `f` to the sequence of Rose trees `roses`."
97 {:no-doc true}
98 [f roses]
99 (make-rose
100 (apply f (map root roses))
101 (map (partial zip f)
102 (permutations roses))))
103
104 (defn remove
105 {:no-doc true}
106 [roses]
107 (concat
108 (map-indexed (fn [index _] (exclude-nth index roses)) roses)
109 (permutations (vec roses))))
110
111 (defn shrink
112 {:no-doc true}
113 [f roses]
114 (if (core/seq roses)
115 (make-rose (apply f (map root roses))
116 (map (partial shrink f) (remove roses)))
117 (make-rose (f) [])))
118
119 (defn collapse
120 "Return a new rose-tree whose depth-one children
121 are the children from depth one _and_ two of the input
122 tree."
123 {:no-doc true}
124 [[root the-children]]
125 (make-rose
126 root
127 (concat (map collapse the-children)
128 (map collapse
129 (mapcat children the-children)))))
130
131 (defn- make-stack
132 [children stack]
133 (if-let [s (core/seq children)]
134 (cons children stack)
135 stack))
136
137 (defn seq
138 "Create a lazy-seq of all of the (unique) nodes in a shrink-tree.
139 This assumes that two nodes with the same value have the same children.
140 While it's not common, it's possible to create trees that don't
141 fit that description. This function is significantly faster than
142 brute-force enumerating all of the nodes in a tree, as there will
143 be many duplicates."
144 [root]
145 (let [helper (fn helper [[node children] seen stack]
146 (lazy-seq
147 (if-not (seen node)
148 (cons node
149 (if (core/seq children)
150 (helper (first children) (conj seen node) (make-stack (rest children) stack))
151 (when-let [s (core/seq stack)]
152 (let [f (ffirst s)
153 r (rest (first s))]
154 (helper f (conj seen node) (make-stack r (rest s)))))))
155 (when-let [s (core/seq stack)]
156 (let [f (ffirst s)
157 r (rest (first s))]
158 (helper f seen (make-stack r (rest s))))))))]
159 (helper root #{} '())))
+0
-160
src/main/clojure/clojure/test/check/rose_tree.cljs less more
0 ; Copyright (c) Rich Hickey, Reid Draper, and contributors.
1 ; All rights reserved.
2 ; The use and distribution terms for this software are covered by the
3 ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
4 ; which can be found in the file epl-v10.html at the root of this distribution.
5 ; By using this software in any fashion, you are agreeing to be bound by
6 ; the terms of this license.
7 ; You must not remove this notice, or any other, from this software.
8
9 (ns clojure.test.check.rose-tree
10 "A lazy tree data structure used for shrinking."
11 (:refer-clojure :exclude [filter remove seq])
12 (:require [cljs.core :as core]))
13
14 (deftype RoseTree [root children])
15
16 (defn root
17 "Returns the root of a Rose tree."
18 {:no-doc true}
19 [rose]
20 (.-root rose))
21
22 (defn children
23 "Returns the children of the root of the Rose tree."
24 {:no-doc true}
25 [rose]
26 (.-children rose))
27
28 (defn make-rose
29 [root children]
30 (RoseTree. root children))
31
32 (defn- exclude-nth
33 "Exclude the nth value in a collection."
34 [n coll]
35 (lazy-seq
36 (when-let [s (core/seq coll)]
37 (if (zero? n)
38 (rest coll)
39 (cons (first s)
40 (exclude-nth (dec n) (rest s)))))))
41
42 (defn join
43 "Turn a tree of trees into a single tree. Does this by concatenating
44 children of the inner and outer trees."
45 {:no-doc true}
46 [rose]
47 (let [outer-root (root rose)
48 outer-children (children rose)
49 inner-root (root outer-root)
50 inner-children (children outer-root)]
51 (make-rose inner-root (concat (map join outer-children)
52 inner-children))))
53
54 (defn pure
55 "Puts a value `x` into a Rose tree, with no children."
56 {:no-doc true}
57 [x]
58 (make-rose x []))
59
60 (defn fmap
61 "Applies functions `f` to all values in the tree."
62 {:no-doc true}
63 [f rose]
64 (make-rose (f (root rose)) (map #(fmap f %) (children rose))))
65
66 (defn bind
67 "Takes a Rose tree (m) and a function (k) from
68 values to Rose tree and returns a new Rose tree.
69 This is the monadic bind (>>=) for Rose trees."
70 {:no-doc true}
71 [m k]
72 (join (fmap k m)))
73
74 (defn filter
75 "Returns a new Rose tree whose values pass `pred`. Values who
76 do not pass `pred` have their children cut out as well.
77 Takes a list of roses, not a rose"
78 {:no-doc true}
79 [pred rose]
80 (make-rose (root rose)
81 (map #(filter pred %)
82 (core/filter #(pred (root %)) (children rose)))))
83
84 (defn permutations
85 "Create a seq of vectors, where each rose in turn, has been replaced
86 by its children."
87 {:no-doc true}
88 [roses]
89 (for [[rose index] (map vector roses (range))
90 child (children rose)]
91 (assoc roses index child)))
92
93 (defn zip
94 "Apply `f` to the sequence of Rose trees `roses`."
95 {:no-doc true}
96 [f roses]
97 (make-rose
98 (apply f (map root roses))
99 (map #(zip f %)
100 (permutations roses))))
101
102 (defn remove
103 {:no-doc true}
104 [roses]
105 (concat
106 (map-indexed (fn [index _] (exclude-nth index roses)) roses)
107 (permutations (vec roses))))
108
109 (defn shrink
110 {:no-doc true}
111 [f roses]
112 (if (core/seq roses)
113 (make-rose (apply f (map root roses))
114 (map #(shrink f %) (remove roses)))
115 (make-rose (f) [])))
116
117 (defn collapse
118 "Return a new rose-tree whose depth-one children
119 are the children from depth one _and_ two of the input
120 tree."
121 {:no-doc true}
122 [rose]
123 (make-rose (root rose)
124 (let [the-children (children rose)]
125 (concat (map collapse the-children)
126 (map collapse
127 (mapcat children the-children))))))
128
129 (defn- make-stack
130 [children stack]
131 (if-let [s (core/seq children)]
132 (cons children stack)
133 stack))
134
135 (defn seq
136 "Create a lazy-seq of all of the (unique) nodes in a shrink-tree.
137 This assumes that two nodes with the same value have the same children.
138 While it's not common, it's possible to create trees that don't
139 fit that description. This function is significantly faster than
140 brute-force enumerating all of the nodes in a tree, as there will
141 be many duplicates."
142 [rose]
143 (let [helper (fn helper [rose seen stack]
144 (let [node (root rose)
145 the-children (children rose)]
146 (lazy-seq
147 (if-not (seen node)
148 (cons node
149 (if (core/seq the-children)
150 (helper (first the-children) (conj seen node) (make-stack (rest the-children) stack))
151 (when-let [s (core/seq stack)]
152 (let [f (ffirst s)
153 r (rest (first s))]
154 (helper f (conj seen node) (make-stack r (rest s)))))))
155 (when-let [s (core/seq stack)]
156 (let [f (ffirst s)
157 r (rest (first s))]
158 (helper f seen (make-stack r (rest s)))))))))]
159 (helper rose #{} '())))
+0
-33
src/test/clojure/clojure/test/check/rose_tree_test.clj less more
0 ; Copyright (c) Rich Hickey, Reid Draper, and contributors.
1 ; All rights reserved.
2 ; The use and distribution terms for this software are covered by the
3 ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
4 ; which can be found in the file epl-v10.html at the root of this distribution.
5 ; By using this software in any fashion, you are agreeing to be bound by
6 ; the terms of this license.
7 ; You must not remove this notice, or any other, from this software.
8
9 (ns clojure.test.check.rose-tree-test
10 (:use clojure.test)
11 (:require [clojure.test.check :as tc]
12 [clojure.test.check.generators :as gen]
13 [clojure.test.check.properties :as prop]
14 [clojure.test.check.rose-tree :as rose]
15 [clojure.test.check.clojure-test :as ct :refer (defspec)]))
16
17 (defn depth-one-children
18 [[root children]]
19 (into [] (map rose/root children)))
20
21 (defn depth-one-and-two-children
22 [[root children]]
23 (into []
24 (concat (map rose/root children)
25 (map rose/root (mapcat rose/children children)))))
26
27 (defspec test-collapse-rose
28 100
29 (prop/for-all [i gen/int]
30 (let [tree (#'gen/int-rose-tree i)]
31 (= (depth-one-and-two-children tree)
32 (depth-one-children (rose/collapse tree))))))
+32
-0
src/test/clojure/clojure/test/check/rose_tree_test.cljc less more
0 ; Copyright (c) Rich Hickey, Reid Draper, and contributors.
1 ; All rights reserved.
2 ; The use and distribution terms for this software are covered by the
3 ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
4 ; which can be found in the file epl-v10.html at the root of this distribution.
5 ; By using this software in any fashion, you are agreeing to be bound by
6 ; the terms of this license.
7 ; You must not remove this notice, or any other, from this software.
8
9 (ns clojure.test.check.rose-tree-test
10 (:require [clojure.test.check.generators :as gen]
11 [clojure.test.check.properties :as prop #?@(:cljs [:include-macros true])]
12 [clojure.test.check.rose-tree :as rose]
13 [clojure.test.check.clojure-test :as ct
14 #?(:clj :refer :cljs :refer-macros) (defspec)]))
15
16 (defn depth-one-children
17 [[root children]]
18 (into [] (map rose/root children)))
19
20 (defn depth-one-and-two-children
21 [[root children]]
22 (into []
23 (concat (map rose/root children)
24 (map rose/root (mapcat rose/children children)))))
25
26 (defspec test-collapse-rose
27 100
28 (prop/for-all [i gen/int]
29 (let [tree (#'gen/int-rose-tree i)]
30 (= (depth-one-and-two-children tree)
31 (depth-one-children (rose/collapse tree))))))
+0
-35
src/test/clojure/clojure/test/check/rose_tree_test.cljs less more
0 ; Copyright (c) Rich Hickey, Reid Draper, and contributors.
1 ; All rights reserved.
2 ; The use and distribution terms for this software are covered by the
3 ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
4 ; which can be found in the file epl-v10.html at the root of this distribution.
5 ; By using this software in any fashion, you are agreeing to be bound by
6 ; the terms of this license.
7 ; You must not remove this notice, or any other, from this software.
8
9 (ns clojure.test.check.rose-tree-test
10 (:require [cljs.test :as test :include-macros true]
11 [clojure.test.check :as tc]
12 [clojure.test.check.generators :as gen]
13 [clojure.test.check.properties :as prop :include-macros true]
14 [clojure.test.check.rose-tree :as rose]
15 [clojure.test.check.clojure-test :as ct :refer-macros [defspec]]))
16
17 (defn depth-one-children
18 [rose]
19 (into [] (map rose/root (rose/children rose))))
20
21 (defn depth-one-and-two-children
22 [rose]
23 (let [the-children (rose/children rose)]
24 (into []
25 (concat
26 (map rose/root the-children)
27 (map rose/root (mapcat rose/children the-children))))))
28
29 (defspec test-collapse-rose
30 100
31 (prop/for-all [i gen/int]
32 (let [tree (gen/int-rose-tree i)]
33 (= (depth-one-and-two-children tree)
34 (depth-one-children (rose/collapse tree))))))