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