|
rlm@10
|
1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
rlm@10
|
2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
rlm@10
|
3 ;;
|
|
rlm@10
|
4 ;; Application examples for data types
|
|
rlm@10
|
5 ;;
|
|
rlm@10
|
6 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
rlm@10
|
7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
rlm@10
|
8
|
|
rlm@10
|
9 (ns
|
|
rlm@10
|
10 #^{:author "Konrad Hinsen"
|
|
rlm@10
|
11 :skip-wiki true
|
|
rlm@10
|
12 :doc "Examples for data type definitions"}
|
|
rlm@10
|
13 clojure.contrib.types.examples
|
|
rlm@10
|
14 (:refer-clojure :exclude (deftype))
|
|
rlm@10
|
15 (:use [clojure.contrib.types
|
|
rlm@10
|
16 :only (deftype defadt match)])
|
|
rlm@10
|
17 (:require [clojure.contrib.generic.collection :as gc])
|
|
rlm@10
|
18 (:require [clojure.contrib.generic.functor :as gf]))
|
|
rlm@10
|
19
|
|
rlm@10
|
20 ;
|
|
rlm@10
|
21 ; Multisets implemented as maps to integers
|
|
rlm@10
|
22 ;
|
|
rlm@10
|
23
|
|
rlm@10
|
24 ; The most basic type definition. A more elaborate version could add
|
|
rlm@10
|
25 ; a constructor that verifies that its argument is a map with integer values.
|
|
rlm@10
|
26 (deftype ::multiset multiset
|
|
rlm@10
|
27 "Multiset (demo implementation)")
|
|
rlm@10
|
28
|
|
rlm@10
|
29 ; Some set operations generalized to multisets
|
|
rlm@10
|
30 ; Note that the multiset constructor is nowhere called explicitly, as the
|
|
rlm@10
|
31 ; map operations all preserve the metadata.
|
|
rlm@10
|
32 (defmethod gc/conj ::multiset
|
|
rlm@10
|
33 ([ms x]
|
|
rlm@10
|
34 (assoc ms x (inc (get ms x 0))))
|
|
rlm@10
|
35 ([ms x & xs]
|
|
rlm@10
|
36 (reduce gc/conj (gc/conj ms x) xs)))
|
|
rlm@10
|
37
|
|
rlm@10
|
38 (defmulti union (fn [& sets] (type (first sets))))
|
|
rlm@10
|
39
|
|
rlm@10
|
40 (defmethod union clojure.lang.IPersistentSet
|
|
rlm@10
|
41 [& sets]
|
|
rlm@10
|
42 (apply clojure.set/union sets))
|
|
rlm@10
|
43
|
|
rlm@10
|
44 ; Note: a production-quality implementation should accept standard sets
|
|
rlm@10
|
45 ; and perhaps other collections for its second argument.
|
|
rlm@10
|
46 (defmethod union ::multiset
|
|
rlm@10
|
47 ([ms] ms)
|
|
rlm@10
|
48 ([ms1 ms2]
|
|
rlm@10
|
49 (letfn [(add-item [ms [item n]]
|
|
rlm@10
|
50 (assoc ms item (+ n (get ms item 0))))]
|
|
rlm@10
|
51 (reduce add-item ms1 ms2)))
|
|
rlm@10
|
52 ([ms1 ms2 & mss]
|
|
rlm@10
|
53 (reduce union (union ms1 ms2) mss)))
|
|
rlm@10
|
54
|
|
rlm@10
|
55 ; Let's use it:
|
|
rlm@10
|
56 (gc/conj #{} :a :a :b :c)
|
|
rlm@10
|
57 (gc/conj (multiset {}) :a :a :b :c)
|
|
rlm@10
|
58
|
|
rlm@10
|
59 (union #{:a :b} #{:b :c})
|
|
rlm@10
|
60 (union (multiset {:a 1 :b 1}) (multiset {:b 1 :c 2}))
|
|
rlm@10
|
61
|
|
rlm@10
|
62 ;
|
|
rlm@10
|
63 ; A simple tree structure defined as an algebraic data type
|
|
rlm@10
|
64 ;
|
|
rlm@10
|
65 (defadt ::tree
|
|
rlm@10
|
66 empty-tree
|
|
rlm@10
|
67 (leaf value)
|
|
rlm@10
|
68 (node left-tree right-tree))
|
|
rlm@10
|
69
|
|
rlm@10
|
70 (def a-tree (node (leaf :a)
|
|
rlm@10
|
71 (node (leaf :b)
|
|
rlm@10
|
72 (leaf :c))))
|
|
rlm@10
|
73
|
|
rlm@10
|
74 (defn depth
|
|
rlm@10
|
75 [t]
|
|
rlm@10
|
76 (match t
|
|
rlm@10
|
77 empty-tree 0
|
|
rlm@10
|
78 (leaf _) 1
|
|
rlm@10
|
79 (node l r) (inc (max (depth l) (depth r)))))
|
|
rlm@10
|
80
|
|
rlm@10
|
81 (depth empty-tree)
|
|
rlm@10
|
82 (depth (leaf 42))
|
|
rlm@10
|
83 (depth a-tree)
|
|
rlm@10
|
84
|
|
rlm@10
|
85 ; Algebraic data types with multimethods: fmap on a tree
|
|
rlm@10
|
86 (defmethod gf/fmap ::tree
|
|
rlm@10
|
87 [f t]
|
|
rlm@10
|
88 (match t
|
|
rlm@10
|
89 empty-tree empty-tree
|
|
rlm@10
|
90 (leaf v) (leaf (f v))
|
|
rlm@10
|
91 (node l r) (node (gf/fmap f l) (gf/fmap f r))))
|
|
rlm@10
|
92
|
|
rlm@10
|
93 (gf/fmap str a-tree)
|
|
rlm@10
|
94
|
|
rlm@10
|
95 ;
|
|
rlm@10
|
96 ; Nonsense examples to illustrate all the features of match
|
|
rlm@10
|
97 ; for type constructors.
|
|
rlm@10
|
98 ;
|
|
rlm@10
|
99 (defadt ::foo
|
|
rlm@10
|
100 (bar a b c))
|
|
rlm@10
|
101
|
|
rlm@10
|
102 (defn foo-to-int
|
|
rlm@10
|
103 [a-foo]
|
|
rlm@10
|
104 (match a-foo
|
|
rlm@10
|
105 (bar x x x) x
|
|
rlm@10
|
106 (bar 0 x y) (+ x y)
|
|
rlm@10
|
107 (bar 1 2 3) -1
|
|
rlm@10
|
108 (bar a b 1) (* a b)
|
|
rlm@10
|
109 :else 42))
|
|
rlm@10
|
110
|
|
rlm@10
|
111 (foo-to-int (bar 0 0 0)) ; 0
|
|
rlm@10
|
112 (foo-to-int (bar 0 5 6)) ; 11
|
|
rlm@10
|
113 (foo-to-int (bar 1 2 3)) ; -1
|
|
rlm@10
|
114 (foo-to-int (bar 3 3 1)) ; 9
|
|
rlm@10
|
115 (foo-to-int (bar 0 3 1)) ; 4
|
|
rlm@10
|
116 (foo-to-int (bar 10 20 30)) ; 42
|
|
rlm@10
|
117
|
|
rlm@10
|
118 ;
|
|
rlm@10
|
119 ; Match can also be used for lists, vectors, and maps. Note that since
|
|
rlm@10
|
120 ; algebraic data types are represented as maps, they can be matched
|
|
rlm@10
|
121 ; either with their type constructor and positional arguments, or
|
|
rlm@10
|
122 ; with a map template.
|
|
rlm@10
|
123 ;
|
|
rlm@10
|
124
|
|
rlm@10
|
125 ; Tree depth once again with map templates
|
|
rlm@10
|
126 (defn depth
|
|
rlm@10
|
127 [t]
|
|
rlm@10
|
128 (match t
|
|
rlm@10
|
129 empty-tree 0
|
|
rlm@10
|
130 {:value _} 1
|
|
rlm@10
|
131 {:left-tree l :right-tree r} (inc (max (depth l) (depth r)))))
|
|
rlm@10
|
132
|
|
rlm@10
|
133 (depth empty-tree)
|
|
rlm@10
|
134 (depth (leaf 42))
|
|
rlm@10
|
135 (depth a-tree)
|
|
rlm@10
|
136
|
|
rlm@10
|
137 ; Match for lists, vectors, and maps:
|
|
rlm@10
|
138
|
|
rlm@10
|
139 (for [x ['(1 2 3)
|
|
rlm@10
|
140 [1 2 3]
|
|
rlm@10
|
141 {:x 1 :y 2 :z 3}
|
|
rlm@10
|
142 '(1 1 1)
|
|
rlm@10
|
143 [2 1 2]
|
|
rlm@10
|
144 {:x 1 :y 1 :z 2}]]
|
|
rlm@10
|
145 (match x
|
|
rlm@10
|
146 '(a a a) 'list-of-three-equal-values
|
|
rlm@10
|
147 '(a b c) 'list
|
|
rlm@10
|
148 [a a a] 'vector-of-three-equal-values
|
|
rlm@10
|
149 [a b a] 'vector-of-three-with-first-and-last-equal
|
|
rlm@10
|
150 [a b c] 'vector
|
|
rlm@10
|
151 {:x a :y z} 'map-with-x-equal-y
|
|
rlm@10
|
152 {} 'any-map))
|
