Codebase list test-check-clojure / ad46f85
Adjust rose-tree impl to be closer to cljs version I think there are perf-sensitive (to cljs at least) differences here, though I haven't had time to investigate, so seems safe to keep the cljs half the same. Gary Fredericks 8 years ago
2 changed file(s) with 69 addition(s) and 63 deletion(s). Raw diff Collapse all Expand all
+58
-54
src/main/clojure/clojure/test/check/rose_tree.cljc less more
1616 (= i 1) children
1717 :else not-found)))
1818
19 (defn make-rose [root children]
19 (defn root
20 "Returns the root of a Rose tree."
21 {:no-doc true}
22 [rose]
23 (.-root rose))
24
25 (defn children
26 "Returns the children of the root of the Rose tree."
27 {:no-doc true}
28 [rose]
29 (.-children rose))
30
31 (defn make-rose
32 [root children]
2033 (RoseTree. root children))
2134
2235 (defn- exclude-nth
3346 "Turn a tree of trees into a single tree. Does this by concatenating
3447 children of the inner and outer trees."
3548 {:no-doc true}
36 [[[inner-root inner-children] children]]
37 (make-rose
38 inner-root
39 (concat (map join children)
40 inner-children)))
49 [rose]
50 (let [outer-root (root rose)
51 outer-children (children rose)
52 inner-root (root outer-root)
53 inner-children (children outer-root)]
54 (make-rose inner-root (concat (map join outer-children)
55 inner-children))))
4156
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))
5357
5458 (defn pure
5559 "Puts a value `x` into a Rose tree, with no children."
6064 (defn fmap
6165 "Applies functions `f` to all values in the tree."
6266 {:no-doc true}
63 [f [root children]]
64 (make-rose (f root) (map (partial fmap f) children)))
67 [f rose]
68 (make-rose (f (root rose)) (map #(fmap f %) (children rose))))
6569
6670 (defn bind
6771 "Takes a Rose tree (m) and a function (k) from
7680 do not pass `pred` have their children cut out as well.
7781 Takes a list of roses, not a rose"
7882 {: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))))
83 [pred rose]
84 (make-rose (root rose)
85 (map #(filter pred %)
86 (core/filter #(pred (root %)) (children rose)))))
8487
8588 (defn permutations
8689 "Create a seq of vectors, where each rose in turn, has been replaced
8790 by its children."
8891 {:no-doc true}
8992 [roses]
90 (apply concat
91 (for [[rose index]
92 (map vector roses (range))]
93 (for [child (children rose)] (assoc roses index child)))))
93 (for [[rose index] (map vector roses (range))
94 child (children rose)]
95 (assoc roses index child)))
9496
9597 (defn zip
9698 "Apply `f` to the sequence of Rose trees `roses`."
9799 {:no-doc true}
98100 [f roses]
99101 (make-rose
100 (apply f (map root roses))
101 (map (partial zip f)
102 (permutations roses))))
102 (apply f (map root roses))
103 (map #(zip f %)
104 (permutations roses))))
103105
104106 (defn remove
105107 {:no-doc true}
113115 [f roses]
114116 (if (core/seq roses)
115117 (make-rose (apply f (map root roses))
116 (map (partial shrink f) (remove roses)))
118 (map #(shrink f %) (remove roses)))
117119 (make-rose (f) [])))
118120
119121 (defn collapse
121123 are the children from depth one _and_ two of the input
122124 tree."
123125 {: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)))))
126 [rose]
127 (make-rose (root rose)
128 (let [the-children (children rose)]
129 (concat (map collapse the-children)
130 (map collapse
131 (mapcat children the-children))))))
130132
131133 (defn- make-stack
132134 [children stack]
141143 fit that description. This function is significantly faster than
142144 brute-force enumerating all of the nodes in a tree, as there will
143145 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 #{} '())))
146 [rose]
147 (let [helper (fn helper [rose seen stack]
148 (let [node (root rose)
149 the-children (children rose)]
150 (lazy-seq
151 (if-not (seen node)
152 (cons node
153 (if (core/seq the-children)
154 (helper (first the-children) (conj seen node) (make-stack (rest the-children) stack))
155 (when-let [s (core/seq stack)]
156 (let [f (ffirst s)
157 r (rest (first s))]
158 (helper f (conj seen node) (make-stack r (rest s)))))))
159 (when-let [s (core/seq stack)]
160 (let [f (ffirst s)
161 r (rest (first s))]
162 (helper f seen (make-stack r (rest s)))))))))]
163 (helper rose #{} '())))
+11
-9
src/test/clojure/clojure/test/check/rose_tree_test.cljc less more
1414 #?(:clj :refer :cljs :refer-macros) (defspec)]))
1515
1616 (defn depth-one-children
17 [[root children]]
18 (into [] (map rose/root children)))
17 [rose]
18 (into [] (map rose/root (rose/children rose))))
1919
2020 (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)))))
21 [rose]
22 (let [the-children (rose/children rose)]
23 (into []
24 (concat
25 (map rose/root the-children)
26 (map rose/root (mapcat rose/children the-children))))))
2527
2628 (defspec test-collapse-rose
2729 100
2830 (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))))))
31 (let [tree (#'gen/int-rose-tree i)]
32 (= (depth-one-and-two-children tree)
33 (depth-one-children (rose/collapse tree))))))