my attempt to do the exercises in sicp.

Wednesday, February 4, 2009

sicp exercise 2.86



;; Exercise 2.86.  Suppose we want to handle complex numbers whose real parts, imaginary parts, magnitudes, and angles can be either ordinary numbers, rational numbers, or other numbers we might wish to add to the system. Describe and implement the changes to the system needed to accommodate this. You will have to define operations such as sine and cosine that are generic over ordinary numbers and rational numbers.

;; Answer:

;; 1. the individual packages need to use add,sub,mul,div instead of +,-,*,/ except of integer and real package.
;; 2. the procedures sin,cos,atan,square,sqrt need to be redefined to take advantage of apply-generic.
;; 3. since the generic procedures add, sub, mul, div are used at each package level, these procedures cannot use "drop". So "drop" can be used at a higher level, which "drop"s the result of generic procedure add/sub/mul/div.




(define (square x) (mul x x))
(define *op-table* (make-hash-table 10))
(define (put op type proc)
  (hash-set! *op-table* (list op type) proc))
(define (get op type)
  (hash-ref *op-table* (list op type) '()))

(define (get-highest-type args)
  (define (higher-type? num1-raised num2 num1)
    (let ((type1 (type num1-raised))
          (type2 (type num2)))
      (if (eq? type1 type2)
          num2
          (let ((raise-proc (get 'raise (list type1))))
            (if (null? raise-proc)
                num1
                (higher-type? (raise-proc (contents num1-raised)) num2 num1))))))
  (define (iter num rest-num)
    (cond ((null? rest-num) num)
          (else (iter (higher-type? num (car rest-num) num)
                      (cdr rest-num)))))
  (cond ((null? args) (error "ERROR"))
        ((null? (cdr args)) (car args))
        (else (type (iter (car args) (cdr args))))))

(define (raise-args highest-type args)
  (define (raise-to-type num)
    (if (eq? (type num) highest-type)
        num
        (raise-to-type (raise num))))
  (map raise-to-type args))

(define (apply-generic op . param)
  (define (apply-generic-raised)
    (let ((highest-type (get-highest-type param)))
      (let ((highest-type-args (map (lambda(x) highest-type) param)))
        (let ((proc (get op highest-type-args)))
          (if (null? proc) (error "no matching operation" op  "for types"
                                   highest-type-args)
              (apply proc (map contents (raise-args highest-type param))))))))
  (let ((type-tags (map type param)))
    (let ((proc (get op type-tags)))
      (if (not (null? proc)) (apply proc (map contents param))
          (apply-generic-raised)))))


(define (drop num)
  (let ((project-proc (get 'project (list (type num)))))
    (if (null? project-proc) num
        (let ((projected-num (project-proc (contents num))))
          (if (equ? (raise projected-num) num)
              (drop projected-num)
              num)))))


;;
;;  number-system
;;

(define (is_integer? x)
  (and (integer? x) (exact? x)))

(define (is_real? x)
  (and (real? x) (inexact? x)))

(define (attach-tag tag oper)
  (cond ((is_integer? oper) oper)
        ((is_real? oper) oper)
        (else (list tag oper))))

(define (type data)
  (cond ((is_integer? data) 'integer)
        ((is_real? data) 'real-number)
        (else (car data))))

(define (contents data)
  (cond ((is_integer? data) data)
        ((is_real? data) data)
        (else (cadr data))))

(define (add x y) (apply-generic 'add x y))
(define (sub x y) (apply-generic 'sub x y))
(define (mul x y) (apply-generic 'mul x y))
(define (div x y) (apply-generic 'div x y))
(define (equ? x y) (apply-generic 'equ? x y))
(define (=zero? x) (apply-generic '=zero? x))
(define (raise x) (apply-generic 'raise x))
(define (project x) (apply-generic 'project x))
(define (sqrt* x) (apply-generic 'sqrt x))
(define (sin* x) (apply-generic 'sin x))
(define (cos* x) (apply-generic 'cos x))
(define (atan* x y) (apply-generic 'atan x y))


(define (install-integer-package)
  (define (tag x)
    (attach-tag 'integer x))  
  (put 'add '(integer integer)
       (lambda (x y) (tag (+ x y))))
  (put 'sub '(integer integer)
       (lambda (x y) (tag (- x y))))
  (put 'mul '(integer integer)
       (lambda (x y) (tag (* x y))))
  (put 'div '(integer integer)
       (lambda (x y) (tag (/ x y))))
  (put 'make 'integer
       (lambda (x) (tag x)))
  (put 'equ? '(integer integer)
       (lambda(x y)(= x y)))
  (put '=zero? '(integer)
       (lambda(x)(= x 0)))
  (put 'raise '(integer)
       (lambda(x)(make-rational x 1)))
  (put 'sqrt '(integer) sqrt)
  (put 'sin '(integer) sin)
  (put 'cos '(integer) cos)
  (put 'atan '(integer integer) atan)
  'done)

(define (make-integer n)
  ((get 'make 'integer) (drop n)))

(define (install-rational-package)
  ;; internal procedures
  (define (numer x) (car x))
  (define (denom x) (cdr x))
  (define (make-rat n d)
    (let ((g (gcd n d)))
      (cons (/ n g) (/ d g))))
  (define (add-rat x y)
    (make-rat (+ (* (numer x) (denom y))
                 (* (numer y) (denom x)))
              (* (denom x) (denom y))))
  (define (sub-rat x y)
    (make-rat (- (* (numer x) (denom y))
                 (* (numer y) (denom x)))
              (* (denom x) (denom y))))
  (define (mul-rat x y)
    (make-rat (* (numer x) (numer y))
              (* (denom x) (denom y))))
  (define (div-rat x y)
    (make-rat (* (numer x) (denom y))
              (* (denom x) (numer y))))
  (define (eq? x y)
    (and (= (numer x) (numer y))
         (= (denom x) (denom y))))
  (define (=zero? x)
    (= (numer x) 0))
  (define (raise x)
    (make-real-number (exact->inexact (/ (numer x) (denom x)))))
  (define (project x)
    (numer x))

  ;; interface to rest of the system
  (define (tag x)
    (attach-tag 'rational x))
  (put 'add '(rational rational)
       (lambda (x y) (tag (add-rat x y))))
  (put 'sub '(rational rational)
       (lambda (x y) (tag (sub-rat x y))))
  (put 'mul '(rational rational)
       (lambda (x y) (tag (mul-rat x y))))
  (put 'div '(rational rational)
       (lambda (x y) (tag (div-rat x y))))
  (put 'equ? '(rational rational) eq?)
  (put '=zero? '(rational) =zero?)
  (put 'raise  '(rational) raise)
  (put 'project  '(rational) project)
  (put 'sqrt '(rational) (lambda(x)(sqrt (raise x))))
  (put 'sin '(rational) (lambda(x)(sin (raise x))))
  (put 'cos '(rational) (lambda(x)(cos (raise x))))
  (put 'atan '(rational rational) (lambda(x y)(atan (raise x) (raise y))))
  (put 'make 'rational
       (lambda (n d) (tag (make-rat n d))))
  'done)

(define (make-rational n d)
  ((get 'make 'rational) (drop n) (drop d)))

(define (install-real-number-package)
  (define (tag x)
    (attach-tag 'real-number x))   
  (put 'add '(real-number real-number)
       (lambda (x y) (tag (+ x y))))
  (put 'sub '(real-number real-number)
       (lambda (x y) (tag (- x y))))
  (put 'mul '(real-number real-number)
       (lambda (x y) (tag (* x y))))
  (put 'div '(real-number real-number)
       (lambda (x y) (tag (/ x y))))
  (put 'make 'real-number
       (lambda (x) (tag (* 1.0 x))))
  (put 'equ? '(real-number real-number)
       (lambda(x y)(= x y)))
  (put '=zero? '(real-number)
       (lambda(x)(= x 0)))
  (put 'raise '(real-number)
       (lambda(x)(make-complex-from-real-imag x 0)))
  (put 'project '(real-number)
       (lambda(x)(make-rational (numerator (rationalize (inexact->exact x) 1/100))
                                (denominator (rationalize (inexact->exact x) 1/100)))))
  (put 'sqrt '(real-number) sqrt)
  (put 'sin '(real-number) sin)
  (put 'cos '(real-number) cos)
  (put 'atan '(real-number real-number) atan)
  'done)

(define (make-real-number n)
  ((get 'make 'real-number) n))


(define (install-rectangular-package)
  ;; internal procedures
  (define (real-part z) (car z))
  (define (imag-part z) (cdr z))
  (define (make-from-real-imag x y) (cons x y))
  (define (magnitude z)
    (sqrt* (add (square (real-part z))
             (square (imag-part z)))))
  (define (angle z)
    (atan* (imag-part z) (real-part z)))
  (define (make-from-mag-ang r a)
    (cons (mul r (cos* a)) (mul r (sin* a))))
  (define (eq? z1 z2)
    (and (equ? (real-part z1) (real-part z2))
         (equ? (imag-part z1) (imag-part z2))))
  (define (=zero? z)
    (and (equ? (real-part z) 0)
         (equ? (imag-part z) 0)))
  ;; interface to the rest of the system
  (define (tag x) (attach-tag 'rectangular x))
  (put 'real-part '(rectangular) real-part)
  (put 'imag-part '(rectangular) imag-part)
  (put 'magnitude '(rectangular) magnitude)
  (put 'angle '(rectangular) angle)
  (put 'make-from-real-imag 'rectangular
       (lambda (x y) (tag (make-from-real-imag x y))))
  (put 'make-from-mag-ang 'rectangular
       (lambda (r a) (tag (make-from-mag-ang r a))))
  (put 'equ?    '(rectangular rectangular) eq?)
  (put 'equ?    '(rectangular polar) eq?)
  (put '=zero? '(rectangular) =zero?)
  'done)

(define (real-part z)
  (apply-generic 'real-part z))
(define (imag-part z)
  (apply-generic 'imag-part z))

(define (install-polar-package)
  ;; internal procedures
  (define (magnitude z) (car z))
  (define (angle z) (cdr z))
  (define (make-from-mag-ang r a) (cons r a))
  (define (real-part z)
    (mul (magnitude z) (cos* (angle z))))
  (define (imag-part z)
    (mul (magnitude z) (sin* (angle z))))
  (define (make-from-real-imag x y)
    (cons (sqrt* (add (square x) (square y)))
          (atan* y x)))
  (define (eq? z1 z2)
    (and (equ? (magnitude z1) (magnitude z2))
         (equ? (angle z1) (angle z2))))
  (define (=zero? z)
    (equ? (magnitude z) 0))
  ;; interface to the rest of the system
  (define (tag x)
    (attach-tag 'polar x))
  (put 'real-part '(polar) real-part)
  (put 'imag-part '(polar) imag-part)
  (put 'magnitude '(polar) magnitude)
  (put 'angle '(polar) angle)
  (put 'make-from-real-imag 'polar
       (lambda (x y) (tag (make-from-real-imag x y))))
  (put 'make-from-mag-ang 'polar
       (lambda (r a) (tag (make-from-mag-ang r a))))
  (put 'equ?   '(polar polar) eq?)
  (put 'equ?   '(polar rectangular) eq?)
  (put '=zero? '(polar) =zero?)
  'done)
(define (magnitude z)
  (apply-generic 'magnitude z))
(define (angle z)
  (apply-generic 'angle z))


(define (install-complex-package)
  ;; imported procedures from rectangular and polar packages
  (define (make-from-real-imag x y)
    ((get 'make-from-real-imag 'rectangular) x y))
  (define (make-from-mag-ang x y)
    ((get 'make-from-mag-ang 'polar) x y))
  ;; internal procedures
  (define (add-complex z1 z2)
    (make-from-real-imag (add (real-part z1) (real-part z2))
                         (add (imag-part z1) (imag-part z2))))
  (define (sub-complex z1 z2)
    (make-from-real-imag (sub (real-part z1) (real-part z2))
                         (sub (imag-part z1) (imag-part z2))))
  (define (mul-complex z1 z2)
    (make-from-mag-ang (mul (magnitude z1) (magnitude z2))
                       (add (angle z1) (angle z2))))
  (define (div-complex z1 z2)
    (make-from-mag-ang (div (magnitude z1) (magnitude z2))
                       (sub (angle z1) (angle z2))))
  
  ;; interface to rest of the system
  (define (tag z)
    (attach-tag 'complex z))
  (put 'add '(complex complex)
       (lambda (z1 z2) (tag (add-complex z1 z2))))
  (put 'sub '(complex complex)
       (lambda (z1 z2) (tag (sub-complex z1 z2))))
  (put 'mul '(complex complex)
       (lambda (z1 z2) (tag (mul-complex z1 z2))))
  (put 'div '(complex complex)
       (lambda (z1 z2) (tag (div-complex z1 z2))))
  (put 'make-from-real-imag 'complex
       (lambda (x y) (tag (make-from-real-imag x y))))
  (put 'equ? '(complex complex) equ?)
  (put '=zero? '(complex) =zero?)

  (put 'real-part '(complex) real-part)
  (put 'imag-part '(complex) imag-part)
  (put 'magnitude '(complex) magnitude)
  (put 'angle '(complex) angle)
  (put 'project '(complex)
        (lambda(z)(make-real-number (real-part z))))

  'done)

(define (make-complex-from-real-imag x y)
  ((get 'make-from-real-imag 'complex) x y))


(install-integer-package)
(install-rational-package)
(install-real-number-package)
(install-rectangular-package)
(install-polar-package)
(install-complex-package)


;;
;;  testing
;;



(define x (make-complex-from-real-imag 1 2))
(define y (make-complex-from-real-imag 1 -2))
(display "------------") (newline)
(display (drop (add x x))) (newline)
(display (drop (add x y))) (newline)
(display (drop (mul x x))) (newline)
(display (drop (mul x y))) (newline)
(display (drop (div x x))) (newline)
(display (drop (div y y))) (newline)
(display (drop (sub x y))) (newline)

(define rat-1 (make-rational 1 2))
(define rat-2 (make-rational 3 4))
(define cmplx (make-complex-from-real-imag rat-1 rat-2))


(display rat-1) (newline)
(display rat-2) (newline)
(display cmplx) (newline)

(display (add cmplx rat-1)) (newline)
(display (drop (add cmplx rat-1))) (newline)

(display (sub cmplx rat-1)) (newline)
(display (drop (sub cmplx rat-1))) (newline)

(display (mul cmplx rat-1)) (newline)
(display (drop (mul cmplx rat-1))) (newline)

(display (div cmplx rat-1)) (newline)
(display (drop (div cmplx rat-1))) (newline)


Monday, February 2, 2009

sicp exercise 2.85



;; Exercise 2.85.  This section mentioned a method for ``simplifying'' a data object by lowering it in the tower of types as far as possible. Design a procedure drop that accomplishes this for the tower described in exercise 2.83. The key is to decide, in some general way, whether an object can be lowered. For example, the complex number 1.5 + 0i can be lowered as far as real, the complex number 1 + 0i can be lowered as far as integer, and the complex number 2 + 3i cannot be lowered at all. Here is a plan for determining whether an object can be lowered: Begin by defining a generic operation project that ``pushes'' an object down in the tower. For example, projecting a complex number would involve throwing away the imaginary part. Then a number can be dropped if, when we project it and raise the result back to the type we started with, we end up with something equal to what we started with. Show how to implement this idea in detail, by writing a drop procedure that drops an object as far as possible. You will need to design the various projection operations53 and install project as a generic operation in the system. You will also need to make use of a generic equality predicate, such as described in exercise 2.79. Finally, use drop to rewrite apply-generic from exercise 2.84 so that it ``simplifies'' its answers.



(define (square x) (* x x))
(define *op-table* (make-hash-table 10))
(define (put op type proc)
  (hash-set! *op-table* (list op type) proc))
(define (get op type)
  (hash-ref *op-table* (list op type) '()))

(define (get-highest-type args)
  (define (higher-type? num1-raised num2 num1)
    (let ((type1 (type num1-raised))
          (type2 (type num2)))
      (if (eq? type1 type2)
          num2
          (let ((raise-proc (get 'raise (list type1))))
            (if (null? raise-proc)
                num1
                (higher-type? (raise-proc (contents num1-raised)) num2 num1))))))
  (define (iter num rest-num)
    (cond ((null? rest-num) num)
          (else (iter (higher-type? num (car rest-num) num)
                      (cdr rest-num)))))
  (cond ((null? args) (error "ERROR"))
        ((null? (cdr args)) (car args))
        (else (type (iter (car args) (cdr args))))))

(define (raise-args highest-type args)
  (define (raise-to-type num)
    (if (eq? (type num) highest-type)
        num
        (raise-to-type (raise num))))
  (map raise-to-type args))

(define (apply-generic op . param)
  (define (apply-generic-raised)
    (let ((highest-type (get-highest-type param)))
      (let ((highest-type-args (map (lambda(x) highest-type) param)))
        (let ((proc (get op highest-type-args)))
          (if (null? proc) (error "no matching operation" op  "for types"
                                   highest-type-args)
              (apply proc (map contents (raise-args highest-type param))))))))
  (let ((type-tags (map type param)))
    (let ((proc (get op type-tags)))
      (if (not (null? proc)) (apply proc (map contents param))
          (apply-generic-raised)))))


(define (drop num)
  (let ((project-proc (get 'project (list (type num)))))
    (if (null? project-proc) num
        (let ((projected-num (project-proc (contents num))))
          (if (equ? (raise projected-num) num)
              (drop projected-num)
              num)))))


;;
;;  number-system
;;

(define (is_integer? x)
  (and (integer? x) (exact? x)))

(define (is_real? x)
  (and (real? x) (inexact? x)))

(define (attach-tag tag oper)
  (cond ((is_integer? oper) oper)
        ((is_real? oper) oper)
        (else (list tag oper))))

(define (type data)
  (cond ((is_integer? data) 'integer)
        ((is_real? data) 'real-number)
        (else (car data))))

(define (contents data)
  (cond ((is_integer? data) data)
        ((is_real? data) data)
        (else (cadr data))))

(define (add x y) (drop (apply-generic 'add x y)))
(define (sub x y) (drop (apply-generic 'sub x y)))
(define (mul x y) (drop (apply-generic 'mul x y)))
(define (div x y) (drop (apply-generic 'div x y)))
(define (equ? x y) (apply-generic 'equ? x y))
(define (=zero? x) (apply-generic '=zero? x))
(define (raise x) (apply-generic 'raise x))

(define (install-integer-package)
  (define (tag x)
    (attach-tag 'integer x))  
  (put 'add '(integer integer)
       (lambda (x y) (tag (+ x y))))
  (put 'sub '(integer integer)
       (lambda (x y) (tag (- x y))))
  (put 'mul '(integer integer)
       (lambda (x y) (tag (* x y))))
  (put 'div '(integer integer)
       (lambda (x y) (tag (/ x y))))
  (put 'make 'integer
       (lambda (x) (tag x)))
  (put 'equ? '(integer integer)
       (lambda(x y)(= x y)))
  (put '=zero? '(integer)
       (lambda(x)(= x 0)))
  (put 'raise '(integer)
       (lambda(x)(make-rational x 1)))
  'done)

(define (make-integer n)
  ((get 'make 'integer) n))

(define (install-rational-package)
  ;; internal procedures
  (define (numer x) (car x))
  (define (denom x) (cdr x))
  (define (make-rat n d)
    (let ((g (gcd n d)))
      (cons (/ n g) (/ d g))))
  (define (add-rat x y)
    (make-rat (+ (* (numer x) (denom y))
                 (* (numer y) (denom x)))
              (* (denom x) (denom y))))
  (define (sub-rat x y)
    (make-rat (- (* (numer x) (denom y))
                 (* (numer y) (denom x)))
              (* (denom x) (denom y))))
  (define (mul-rat x y)
    (make-rat (* (numer x) (numer y))
              (* (denom x) (denom y))))
  (define (div-rat x y)
    (make-rat (* (numer x) (denom y))
              (* (denom x) (numer y))))
  (define (eq? x y)
    (and (= (numer x) (numer y))
         (= (denom x) (denom y))))
  (define (=zero? x)
    (= (numer x) 0))
  (define (raise x)
    (make-real-number (exact->inexact (/ (numer x) (denom x)))))
  (define (project x)
    (numer x))

  ;; interface to rest of the system
  (define (tag x)
    (attach-tag 'rational x))
  (put 'add '(rational rational)
       (lambda (x y) (tag (add-rat x y))))
  (put 'sub '(rational rational)
       (lambda (x y) (tag (sub-rat x y))))
  (put 'mul '(rational rational)
       (lambda (x y) (tag (mul-rat x y))))
  (put 'div '(rational rational)
       (lambda (x y) (tag (div-rat x y))))
  (put 'equ? '(rational rational) eq?)
  (put '=zero? '(rational) =zero?)
  (put 'raise  '(rational) raise)
  (put 'project  '(rational) project)
  (put 'make 'rational
       (lambda (n d) (tag (make-rat n d))))
  'done)

(define (make-rational n d)
  ((get 'make 'rational) n d))

(define (install-real-number-package)
  (define (tag x)
    (attach-tag 'real-number x))   
  (put 'add '(real-number real-number)
       (lambda (x y) (tag (+ x y))))
  (put 'sub '(real-number real-number)
       (lambda (x y) (tag (- x y))))
  (put 'mul '(real-number real-number)
       (lambda (x y) (tag (* x y))))
  (put 'div '(real-number real-number)
       (lambda (x y) (tag (/ x y))))
  (put 'make 'real-number
       (lambda (x) (tag (* 1.0 x))))
  (put 'equ? '(real-number real-number)
       (lambda(x y)(= x y)))
  (put '=zero? '(real-number)
       (lambda(x)(= x 0)))
  (put 'raise '(real-number)
       (lambda(x)(make-complex-from-real-imag x 0)))
  (put 'project '(real-number)
       (lambda(x)(make-rational (numerator (rationalize (inexact->exact x) 1/100))
                                (denominator (rationalize (inexact->exact x) 1/100)))))
  (put 'sqrt '(real-number) sqrt)
  'done)

(define (make-real-number n)
  ((get 'make 'real-number) n))


(define (install-rectangular-package)
  ;; internal procedures
  (define (real-part z) (car z))
  (define (imag-part z) (cdr z))
  (define (make-from-real-imag x y) (cons x y))
  (define (magnitude z)
    (sqrt (+ (square (real-part z))
             (square (imag-part z)))))
  (define (angle z)
    (atan (imag-part z) (real-part z)))
  (define (make-from-mag-ang r a)
    (cons (* r (cos a)) (* r (sin a))))
  (define (eq? z1 z2)
    (and (= (real-part z1) (real-part z2))
         (= (imag-part z1) (imag-part z2))))
  (define (=zero? z)
    (and (= (real-part z) 0)
         (= (imag-part z) 0)))
  ;; interface to the rest of the system
  (define (tag x) (attach-tag 'rectangular x))
  (put 'real-part '(rectangular) real-part)
  (put 'imag-part '(rectangular) imag-part)
  (put 'magnitude '(rectangular) magnitude)
  (put 'angle '(rectangular) angle)
  (put 'make-from-real-imag 'rectangular
       (lambda (x y) (tag (make-from-real-imag x y))))
  (put 'make-from-mag-ang 'rectangular
       (lambda (r a) (tag (make-from-mag-ang r a))))
  (put 'equ?    '(rectangular rectangular) eq?)
  (put 'equ?    '(rectangular polar) eq?)
  (put '=zero? '(rectangular) =zero?)
  'done)

(define (real-part z)
  (apply-generic 'real-part z))
(define (imag-part z)
  (apply-generic 'imag-part z))

(define (install-polar-package)
  ;; internal procedures
  (define (magnitude z) (car z))
  (define (angle z) (cdr z))
  (define (make-from-mag-ang r a) (cons r a))
  (define (real-part z)
    (* (magnitude z) (cos (angle z))))
  (define (imag-part z)
    (* (magnitude z) (sin (angle z))))
  (define (make-from-real-imag x y)
    (cons (sqrt (+ (square x) (square y)))
          (atan y x)))
  (define (eq? z1 z2)
    (and (= (magnitude z1) (magnitude z2))
         (= (angle z1) (angle z2))))
  (define (=zero? z)
    (= (magnitude z) 0))
  ;; interface to the rest of the system
  (define (tag x)
    (attach-tag 'polar x))
  (put 'real-part '(polar) real-part)
  (put 'imag-part '(polar) imag-part)
  (put 'magnitude '(polar) magnitude)
  (put 'angle '(polar) angle)
  (put 'make-from-real-imag 'polar
       (lambda (x y) (tag (make-from-real-imag x y))))
  (put 'make-from-mag-ang 'polar
       (lambda (r a) (tag (make-from-mag-ang r a))))
  (put 'equ?   '(polar polar) eq?)
  (put 'equ?   '(polar rectangular) eq?)
  (put '=zero? '(polar) =zero?)
  'done)
(define (magnitude z)
  (apply-generic 'magnitude z))
(define (angle z)
  (apply-generic 'angle z))


(define (install-complex-package)
  ;; imported procedures from rectangular and polar packages
  (define (make-from-real-imag x y)
    ((get 'make-from-real-imag 'rectangular) x y))
  (define (make-from-mag-ang x y)
    ((get 'make-from-mag-ang 'polar) x y))
  ;; internal procedures
  (define (add-complex z1 z2)
    (make-from-real-imag (+ (real-part z1) (real-part z2))
                         (+ (imag-part z1) (imag-part z2))))
  (define (sub-complex z1 z2)
    (make-from-real-imag (- (real-part z1) (real-part z2))
                         (- (imag-part z1) (imag-part z2))))
  (define (mul-complex z1 z2)
    (make-from-mag-ang (* (magnitude z1) (magnitude z2))
                       (+ (angle z1) (angle z2))))
  (define (div-complex z1 z2)
    (make-from-mag-ang (/ (magnitude z1) (magnitude z2))
                       (- (angle z1) (angle z2))))
  
  ;; interface to rest of the system
  (define (tag z)
    (attach-tag 'complex z))
  (put 'add '(complex complex)
       (lambda (z1 z2) (tag (add-complex z1 z2))))
  (put 'sub '(complex complex)
       (lambda (z1 z2) (tag (sub-complex z1 z2))))
  (put 'mul '(complex complex)
       (lambda (z1 z2) (tag (mul-complex z1 z2))))
  (put 'div '(complex complex)
       (lambda (z1 z2) (tag (div-complex z1 z2))))
  (put 'make-from-real-imag 'complex
       (lambda (x y) (tag (make-from-real-imag x y))))
  (put 'equ? '(complex complex) equ?)
  (put '=zero? '(complex) =zero?)

  (put 'real-part '(complex) real-part)
  (put 'imag-part '(complex) imag-part)
  (put 'magnitude '(complex) magnitude)
  (put 'angle '(complex) angle)
  (put 'project '(complex)
        (lambda(z)(make-real-number (real-part z))))

  'done)

(define (make-complex-from-real-imag x y)
  ((get 'make-from-real-imag 'complex) x y))


(install-integer-package)
(install-rational-package)
(install-real-number-package)
(install-rectangular-package)
(install-polar-package)
(install-complex-package)


;;
;;  testing
;;



(define x (make-complex-from-real-imag 1 2))
(define y (make-complex-from-real-imag 1 -2))
(display "------------") (newline)
(display (add x x)) (newline)
(display (add x y)) (newline)
(display (mul x x)) (newline)
(display (mul x y)) (newline)
(display (div x x)) (newline)
(display (div y y)) (newline)
(display (sub x y)) (newline)