-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathbook_2_4.clj
239 lines (190 loc) · 5.6 KB
/
book_2_4.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
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
(ns sicp.chapter-2.part-4.book-2-4)
(comment "2.4 Multiple Representations for Abstract Data -----------------------------------------")
(comment "2.4.1 Representations for Complex Numbers ----------------------------------------------")
; Ben's way ----------------------------------------------------------------------------------------
(defn Ben-real-part
[z]
(float (first z)))
(defn Ben-imag-part
[z]
(float (second z)))
(defn Ben-magnitude
[z]
(Math/sqrt (+ (Math/pow (Ben-real-part z) 2)
(Math/pow (Ben-imag-part z) 2))))
(defn Ben-angle
[z]
(Math/atan2 (Ben-imag-part z) (Ben-real-part z)))
(defn Ben-make-from-real-imag
([x y] [(float x) (float y)])
([z] [(Ben-real-part z) (Ben-imag-part z)]))
(defn Ben-make-from-mag-ang
([r a] [(* r (Math/cos a)) (* r (Math/sin a))])
([z] [(Ben-magnitude z) (Ben-angle z)]))
(defn Ben-add-complex
[z1 z2]
(Ben-make-from-real-imag
(+ (Ben-real-part z1) (Ben-real-part z2))
(+ (Ben-imag-part z1) (Ben-imag-part z2))))
(defn Ben-sub-complex
[z1 z2]
(Ben-make-from-real-imag
(- (Ben-real-part z1) (Ben-real-part z2))
(- (Ben-imag-part z1) (Ben-imag-part z2))))
(defn Ben-mul-complex
[z1 z2]
(Ben-make-from-mag-ang
(* (Ben-magnitude z1) (Ben-magnitude z2))
(+ (Ben-angle z1) (Ben-angle z2))))
(defn Ben-div-complex
[z1 z2]
(Ben-make-from-mag-ang
(/ (Ben-magnitude z1) (Ben-magnitude z2))
(- (Ben-angle z1) (Ben-angle z2))))
; Alyssa's way -------------------------------------------------------------------------------------
(defn Alyssa-magnitude
[z]
(first z))
(defn Alyssa-angle
[z]
(second z))
(defn Alyssa-real-part
[z]
(* (Alyssa-magnitude z) (Math/cos (Alyssa-angle z))))
(defn Alyssa-imag-part
[z]
(* (Alyssa-magnitude z) (Math/sin (Alyssa-angle z))))
(defn Alyssa-make-from-real-imag
[x y]
[(Math/sqrt (+ (Math/pow x 2) (Math/pow y 2)))
(Math/atan2 y x)])
(defn Alyssa-make-from-mag-ang
[r a]
[(float r) (float a)])
(comment "2.4.2")
; Tagged data --------------------------------------------------------------------------------------
; Types/tags of data
(defn attach-tag
[type-tag contents]
(cons type-tag contents))
(defn type-tag
[datum]
(cond (sequential? datum) (first datum)
(map? datum) (get datum :tag)
:else (throw (Exception. (str "Bad tagged datum: TYPE-TAG " datum)))))
(defn contents
[datum]
(cond (sequential? datum) (rest datum)
(map? datum) (get datum :contents)
:else (throw (Exception. (str "Bad tagged datum: CONTENTS " datum)))))
(defn rectangular?
[z]
(= (type-tag z) :rectangular))
(defn polar?
[z]
(= (type-tag z) :polar))
; Rectangular
(defn real-part-rectangular
[z]
(first z))
(defn imag-part-rectangular
[z]
(second z))
(defn magnitude-rectangular
[z]
(Math/sqrt (+ (Math/pow (real-part-rectangular z) 2)
(Math/pow (imag-part-rectangular z) 2))))
(defn angle-rectangular
[z]
(Math/atan2 (imag-part-rectangular z)
(real-part-rectangular z)))
(defn make-from-real-imag-rectangular
[x y]
(attach-tag :rectangular [x y]))
(defn make-from-mag-ang-rectangular
[r a]
(attach-tag :rectangular [(* r (Math/cos a)) (* r (Math/sin a))]))
; Polar
(defn magnitude-polar
[z]
(first z))
(defn angle-polar
[z]
(second z))
(defn real-part-polar
[z]
(* (magnitude-polar z) (Math/cos (angle-polar z))))
(defn imag-part-polar
[z]
(* (magnitude-polar z) (Math/sin (angle-polar z))))
(defn make-from-real-imag-polar
[x y]
(attach-tag :polar
[(Math/sqrt (+ (Math/pow x 2) (Math/pow y 2)))
(Math/atan2 y x)]))
(defn make-from-mag-ang-polar
[r a]
(attach-tag :polar [r a]))
; Compounding of Polar and Rectangular ways
(defn real-part
[z]
(cond
(rectangular? z) (real-part-rectangular (contents z))
(polar? z) (real-part-polar (contents z))
:else (throw (Exception. (str "Unknown type: REAL-PART " z)))))
(defn imag-part
[z]
(cond
(rectangular? z) (imag-part-rectangular (contents z))
(polar? z) (imag-part-polar (contents z))
:else (throw (Exception. (str "Unknown type: IMAG-PART " z)))))
(defn magnitude
[z]
(cond
(rectangular? z) (magnitude-rectangular (contents z))
(polar? z) (magnitude-polar (contents z))
:else (throw (Exception. (str "Unknown type: MAGNITUDE " z)))))
(defn angle
[z]
(cond
(rectangular? z) (angle-rectangular (contents z))
(polar? z) (angle-polar (contents z))
:else (throw (Exception. (str "Unknown type: ANGLE " z)))))
(defn make-from-real-imag-v2
[x y]
(make-from-real-imag-rectangular x y))
(defn add-complex
[z1 z2]
(make-from-real-imag-v2
(+ (real-part z1) (real-part z2))
(+ (imag-part z1) (imag-part z2))))
(defn make-from-mag-ang-v2
[r a]
(make-from-mag-ang-polar r a))
(comment "2.4.3 Data-Directed Programming and Additivity -----------------------------------------")
; Exercises:
; * 2.73
; * 2.74
; * 2.75
; * 2.76
(defn apply-generic
"Just a wrapper for the dispatch table. It's a bit more verbose than the original, I don't use it"
[op & args]
(let [type-tags (map type-tag args)
proc (get op type-tags)]
(if proc
(apply proc (map contents args))
(throw (Exception. (str "No method for these types: APPLY-GENERIC "
(list op type-tags)))))))
(defn make-from-real-imag
[x y]
(fn [op]
(cond
(= op :real-part) x
(= op :imag-part) y
(= op :magnitude) (Math/sqrt (+ (* x x) (* y y)))
(= op :angle) (Math/atan2 y x)
:else (throw (Exception. (str "Unknown op: MAKE-FROM-REAL-IMAG " op))))))
(defn apply-generic-v2
[op arg]
(arg op))