]> git.rkrishnan.org Git - sicp.git/blob - src/sicp/ch2_4.rkt
Solution to 4.44. A bit too verbose. Can be improved by better
[sicp.git] / src / sicp / ch2_4.rkt
1 #lang racket/load
2
3 (require "utils.rkt")
4
5
6 ; section 2.4
7 (define (add-complex z1 z2)
8   (make-from-real-imag (+ (real-part z1) (real-part z2))
9                        (+ (imag-part z1) (imag-part z2))))
10
11 (define (sub-complex z1 z2)
12   (make-from-real-imag (- (real-part z1) (real-part z2))
13                        (- (imag-part z1) (imag-part z2))))
14
15 (define (mul-complex z1 z2)
16   (make-from-mag-ang (* (magnitude z1) (magnitude z2))
17                      (+ (angle z1) (angle z2))))
18
19 (define (div-complex z1 z2)
20   (make-from-mag-ang (/ (magnitude z1) (magnitude z2))
21                      (- (angle z1) (angle z2))))
22
23 ;;; constructors and selectors for rectangular form
24 (define (real-part-rect z) (car z))
25 (define (imag-part-rect z) (cdr z))
26
27 (define (magnitude-rect z)
28   (sqrt (+ (square (real-part-rect z))
29            (square (imag-part-rect z)))))
30
31 (define (angle-rect z)
32   (atan (imag-part-rect z) (real-part-rect z)))
33
34 (define (make-from-real-imag-rect x y) (attach-tag 'rectangular (cons x y)))
35
36 (define (make-from-mag-ang-rect r a)
37   (attach-tag 'rectangular (cons (* r (cos a)) (* r (sin a)))))
38
39 ;;; constructors and selectors for polar form
40 (define (real-part-polar z) (* (magnitude-polar z) 
41                                (cos (angle-polar z))))
42
43 (define (imag-part-polar z) (* (magnitude-polar z) 
44                                (sin (angle-polar z))))
45
46 (define (magnitude-polar z) (car z))
47 (define (angle-polar z)     (cdr z))
48
49 (define (make-from-real-imag x y)
50   (attach-tag 'polar
51               (cons (sqrt (+ (square x) (square y)))
52                     (atan y x))))
53
54 (define (make-from-mag-ang r a) (attach-tag 'polar (cons r a)))
55
56 ;; type tag
57 (define (attach-tag type-tag contents)
58   (cons type-tag contents))
59
60 (define (type-tag datum)
61   (if (pair? datum)
62       (car datum)
63       (error "Bad tagged datum -- TYPE-TAG" datum)))
64
65 (define (contents datum)
66   (if (pair? datum)
67       (cdr datum)
68       (error "Bad tagged datum -- CONTENTS" datum)))
69
70 (define (rectangular? z)
71   (eq? (type-tag z) 'rectangular))
72
73 (define (polar? z)
74   (eq? (type-tag z) 'polar))
75
76 ;; generic procedures
77 (define (real-part z)
78   (cond
79     [(rectangular? z) (real-part-rect (contents z))]
80     [(polar? z)       (real-part-polar (contents z))]
81     [else (error "unknown type -- real-part" z)]))
82
83 (define (imag-part z)
84   (cond
85     [(rectangular? z) (imag-part-rect (contents z))]
86     [(polar? z)       (imag-part-rect (contents z))]
87     [else (error "unknown type -- imag part" z)]))
88
89 (define (magnitude z)
90   (cond
91     [(rectangular? z) (magnitude-rect (contents z))]
92     [(polar? z)       (magnitude-polar (contents z))]
93     [else (error "Unknown type -- MAGNITUDE" z)]))
94
95 (define (angle z)
96   (cond [(rectangular? z) (angle-rect (contents z))]
97         [(polar? z)       (angle-polar (contents z))]
98         [else (error "Unknown type -- ANGLE" z)]))
99
100 (define (make-from-real-imag x y)
101   (make-from-real-imag-rect x y))
102
103 (define (make-from-mag-ang r a)
104   (make-from-mag-ang-polar r a))
105
106 ;;; message passing
107 (define (make-from-real-imag x y)
108   (define (dispatch op)
109     (cond
110       [(eq? op 'real-part) x]
111       [(eq? op 'imag-part) y]
112       [(eq? op 'magnitude)
113        (sqrt (+ (square x) (square y)))]
114       [(eq? op 'angle) (atan y x)]
115       [else 
116        (error "unknown op" op)]))
117   dispatch)
118