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