my attempt to do the exercises in sicp.

Monday, August 17, 2009

sicp exercise 3.8



;; Exercise 3.8.  When we defined the evaluation model in section 1.1.3, we said that the first step in evaluating an expression is to evaluate its subexpressions. But we never specified the order in which the subexpressions should be evaluated (e.g., left to right or right to left). When we introduce assignment, the order in which the arguments to a procedure are evaluated can make a difference to the result. Define a simple procedure f such that evaluating (+ (f 0) (f 1)) will return 0 if the arguments to + are evaluated from left to right but will return 1 if the arguments are evaluated from right to left.


(define f
  (let ((x 1))
    (lambda (num)
      (set! x (* x num))
      x)))

(display (+ (f 1) (f 0))) (newline)
(display (+ (f 0) (f 1))) (newline)


sicp exercise 3.7


;; Exercise 3.7.  Consider the bank account objects created by make-account, with the password modification described in exercise 3.3. Suppose that our banking system requires the ability to make joint accounts. Define a procedure make-joint that accomplishes this. Make-joint should take three arguments. The first is a password-protected account. The second argument must match the password with which the account was defined in order for the make-joint operation to proceed. The third argument is a new password. Make-joint is to create an additional access to the original account using the new password. For example, if peter-acc is a bank account with password open-sesame, then

;;(define paul-acc
;;  (make-joint peter-acc 'open-sesame 'rosebud))

;;  will allow one to make transactions on peter-acc using the name paul-acc and the password rosebud. You may wish to modify your solution to exercise 3.3 to accommodate this new feature.



;; The solution is to seperate the account balance management and password management.

(define (make-balance balance)
  "This procedure is exclusively for balance management"
  (define (withdraw amount)
    (if (>= balance amount)
        (begin (set! balance (- balance amount))
               balance)
        "Insufficient funds"))
  (define (deposit amount)
    (set! balance (+ balance amount))
    balance)
  (define (dispatch m)
      (cond ((eq? m 'withdraw) withdraw)
            ((eq? m 'deposit) deposit)
            (else (error "Unknown request -- MAKE-ACCOUNT"
                         m))))
  dispatch)

(define (make-account balance password)
  "This procedure is exclusively for passwd management
   and gaining access to balance management if the password is correct"
  (define (get-balance)
    (define balance-ref balance)
    balance-ref)
  (define (wrong-passwd arg)
    "Incorrect password")
  (define (check-pass pass)
    (eq? pass password))
  (define (set-passwd pass)
    (set! password pass))
  (define (dispatch passwd cmd)
    (if (eq? cmd 'check-passwd)
          (check-pass passwd)
        (if (eq? passwd password)
              (cond ((eq? cmd 'get-balance) (get-balance))
                    ((eq? cmd 'change-passwd) set-passwd)
                    ((eq? cmd 'check-passwd) #t)
                    (else (balance cmd)))
            wrong-passwd)))
  dispatch)

(define (make-joint-account accnt accnt-passwd passwd)
  (if (accnt accnt-passwd 'check-passwd)
      (make-account (accnt accnt-passwd 'get-balance) passwd)
      "Wrong passwd..."))


(define peter-acc (make-account (make-balance 1000) 'open-sesame))

(display ((peter-acc 'open-sesame 'withdraw) 40)) (newline)
(display ((peter-acc 'open-sesame 'withdraw) 40)) (newline)
(display ((peter-acc 'open-sesame 'withdraw) 40)) (newline)
(display ((peter-acc 'some-other-password 'deposit) 50)) (newline)

(define paul-acc (make-joint-account peter-acc 'open-sesame 'rosebud))

(display ((paul-acc 'rosebud 'withdraw) 40)) (newline)
(display ((paul-acc 'rosebud 'withdraw) 40)) (newline)
(display ((paul-acc 'rosebud 'withdraw) 40)) (newline)
(display ((paul-acc 'some-other-password 'deposit) 50)) (newline)

;; paul can change his passwd, independent of peter
((paul-acc 'rosebud 'change-passwd) 'lotus-leaf)
(display ((paul-acc 'lotus-leaf 'withdraw) 40)) (newline)

;; peter is not affected by change in paul's password
(display ((peter-acc 'open-sesame 'withdraw) 40)) (newline)


sicp exercise 3.6



;; Exercise 3.6.  It is useful to be able to reset a random-number generator to produce a sequence starting from a given value. Design a new rand procedure that is called with an argument that is either the symbol generate or the symbol reset and behaves as follows: (rand 'generate) produces a new random number; ((rand 'reset) <new-value>) resets the internal state variable to the designated <new-value>. Thus, by resetting the state, one can generate repeatable sequences.  are very handy to have when testing and debugging programs that use random numbers.


(define save-random-state (copy-random-state))

(define (rand cmd)
  (cond ((eq? cmd 'generate) random)
        ((eq? cmd 'reset) (lambda(x)(set! *random-state* x)))))

(display ((rand 'generate) 10)) (newline)
(display ((rand 'generate) 10)) (newline)
(display ((rand 'generate) 10)) (newline)
(display ((rand 'generate) 10)) (newline)
(display ((rand 'generate) 10)) (newline)
(display ((rand 'generate) 10)) (newline)
((rand 'reset) save-random-state) (newline)
(display ((rand 'generate) 10)) (newline)
(display ((rand 'generate) 10)) (newline)
(display ((rand 'generate) 10)) (newline)
(display ((rand 'generate) 10)) (newline)
(display ((rand 'generate) 10)) (newline)
(display ((rand 'generate) 10)) (newline)



sicp exercise 3.5



;; Exercise 3.5.  Monte Carlo integration is a method of estimating definite integrals by means of Monte Carlo simulation. Consider computing the area of a region of space described by a predicate P(x, y) that is true for points (x, y) in the region and false for points not in the region. For example, the region contained within a circle of radius 3 centered at (5, 7) is described by the predicate that tests whether (x - 5)2 + (y - 7)2< 32. To estimate the area of the region described by such a predicate, begin by choosing a rectangle that contains the region. For example, a rectangle with diagonally opposite corners at (2, 4) and (8, 10) contains the circle above. The desired integral is the area of that portion of the rectangle that lies in the region. We can estimate the integral by picking, at random, points (x,y) that lie in the rectangle, and testing P(x, y) for each point to determine whether the point lies in the region. If we try this with many points, then the fraction of points that fall in the region should give an estimate of the proportion of the rectangle that lies in the region. Hence, multiplying this fraction by the area of the entire rectangle should produce an estimate of the integral.

;; Implement Monte Carlo integration as a procedure estimate-integral that takes as arguments a predicate P, upper and lower bounds x1, x2, y1, and y2 for the rectangle, and the number of trials to perform in order to produce the estimate. Your procedure should use the same monte-carlo procedure that was used above to estimate . Use your estimate-integral to produce an estimate of by measuring the area of a unit circle.

;; You will find it useful to have a procedure that returns a number chosen at random from a given range. The following random-in-range procedure implements this in terms of the random procedure used in section 1.2.6, which returns a nonnegative number less than its input.

;; (define (random-in-range low high)
;;   (let ((range (- high low)))
;;       (+ low (random range))))


(define (square x) (* x x))

(define (circle-predicate center radius)
  (lambda(x y)
    (<= (+ (square (- x (car center)))
           (square (- y (cdr center))))
        (square radius))))

(define (unit-circle x y)
    (circle-predicate (cons x y) 1))

(define unit-circle-at-0-0
  (unit-circle 0 0))

(define unit-circle-at-1-1
  (unit-circle 1 1))

(define (monte-carlo trials experiment)
  (define (iter trials-remaining trials-passed)
    (cond ((= trials-remaining 0)
           (exact->inexact (/ trials-passed trials)))
          ((experiment)
           (iter (- trials-remaining 1) (+ trials-passed 1)))
          (else
           (iter (- trials-remaining 1) trials-passed))))
  (iter trials 0))

(define (random-in-range low high)
  (let ((range (- high low)))
    (+ low (* range (random:uniform)))))

(define (estimate-integral integral x1 y1 x2 y2 trials)
  (define (test)
    (let ((x (random-in-range (min x1 x2) (max x1 x2)))
          (y (random-in-range (min y1 y2) (max y1 y2))))
      (integral x y)))
  (let ((area (abs (* (- x1 x2) (- y1 y2)))))
    (* area (monte-carlo trials test))))

(display (estimate-integral unit-circle-at-1-1  0 2 2  0 50000)) (newline)
(display (estimate-integral unit-circle-at-0-0 -1 1 1 -1 50000)) (newline)




sicp exercise 3.4


;; Exercise 3.4.  Modify the make-account procedure of exercise 3.3 by adding another local state variable so that, if an account is accessed more than seven consecutive times with an incorrect password, it invokes the procedure call-the-cops.


(define (make-account balance password)
  (define wrong-pass-count 0)
  (define (call-the-cops) "you are under arrest")
  (define (wrong-passwd arg)
    (begin (set! wrong-pass-count (+ 1 wrong-pass-count))
           (if (> wrong-pass-count 7) (call-the-cops)
               "wrong password")))
  (define (withdraw amount)
    (if (>= balance amount)
        (begin (set! balance (- balance amount))
               balance)
        "Insufficient funds"))
  (define (deposit amount)
    (set! balance (+ balance amount))
    balance)
  (define (dispatch passwrd m)
    (if (eq? passwrd password)
      (cond ((eq? m 'withdraw) withdraw)
            ((eq? m 'deposit) deposit)
            (else (error "Unknown request -- MAKE-ACCOUNT"
                         m)))
      wrong-passwd))
  dispatch)

(define acc (make-account 100 'secret-password))

(display ((acc 'secret-password 'withdraw) 40)) (newline)
(display ((acc 'secret-password 'withdraw) 40)) (newline)
(display ((acc 'secret-password 'withdraw) 40)) (newline)
(display ((acc 'some-other-password 'deposit) 50)) (newline)
(display ((acc 'some-other-password 'deposit) 50)) (newline)
(display ((acc 'some-other-password 'deposit) 50)) (newline)
(display ((acc 'some-other-password 'deposit) 50)) (newline)
(display ((acc 'some-other-password 'deposit) 50)) (newline)
(display ((acc 'some-other-password 'deposit) 50)) (newline)
(display ((acc 'some-other-password 'deposit) 50)) (newline)
(display ((acc 'some-other-password 'deposit) 50)) (newline)
(display ((acc 'some-other-password 'deposit) 50)) (newline)
(display ((acc 'some-other-password 'deposit) 50)) (newline)
(display ((acc 'some-other-password 'deposit) 50)) (newline)


sicp exercise 3.3



;; Exercise 3.3.  Modify the make-account procedure so that it creates password-protected accounts. That is, make-account should take a symbol as an additional argument, as in

;; (define acc (make-account 100 'secret-password))

;; The resulting account object should process a request only if it is accompanied by the password with which the account was created, and should otherwise return a complaint:

;; ((acc 'secret-password 'withdraw) 40)
;; 60

;; ((acc 'some-other-password 'deposit) 50)
;; "Incorrect password"

(define (make-account balance password)
  (define (wrong-passwd arg) "Incorrect password")
  (define (withdraw amount)
    (if (>= balance amount)
        (begin (set! balance (- balance amount))
               balance)
        "Insufficient funds"))
  (define (deposit amount)
    (set! balance (+ balance amount))
    balance)
  (define (dispatch passwrd m)
    (if (eq? passwrd password)
      (cond ((eq? m 'withdraw) withdraw)
            ((eq? m 'deposit) deposit)
            (else (error "Unknown request -- MAKE-ACCOUNT"
                         m)))
      wrong-passwd))
  dispatch)

(define acc (make-account 100 'secret-password))

(display ((acc 'secret-password 'withdraw) 40)) (newline)
(display ((acc 'secret-password 'withdraw) 40)) (newline)
(display ((acc 'secret-password 'withdraw) 40)) (newline)
(display ((acc 'some-other-password 'deposit) 50)) (newline)


sicp exercise 3.2



;; Exercise 3.2.  In software-testing applications, it is useful to be able to count the number of times a given procedure is called during the course of a computation. Write a procedure make-monitored that takes as input a procedure, f, that itself takes one input. The result returned by make-monitored is a third procedure, say mf, that keeps track of the number of times it has been called by maintaining an internal counter. If the input to mf is the special symbol how-many-calls?, then mf returns the value of the counter. If the input is the special symbol reset-count, then mf resets the counter to zero. For any other input, mf returns the result of calling f on that input and increments the counter. For instance, we could make a monitored version of the sqrt procedure:

;; (define s (make-monitored sqrt))

;; (s 100)
;; 10

;; (s 'how-many-calls?)
;; 1


(define (make-monitored func)
  (let ((count 0))
    (lambda(arg)
      (cond ((eq? arg 'how-many-calls? ) count)
            ((eq? arg 'reset-count )
              (begin
                (set! count 0) 0))
            (else (begin (set! count (+ 1 count)) (func arg)))))))

(define s (make-monitored sqrt))

(display (s 100)) (newline)
(display (s 200)) (newline)
(display (s 300)) (newline)
(display (s 'how-many-calls?)) (newline)
(display (s 'reset-count)) (newline)
(display (s 100)) (newline)
(display (s 200)) (newline)
(display (s 'how-many-calls?)) (newline)

sicp exercise 3.1



;; Exercise 3.1.  An accumulator is a procedure that is called repeatedly with a single numeric argument and accumulates its arguments into a sum. Each time it is called, it returns the currently accumulated sum. Write a procedure make-accumulator that generates accumulators, each maintaining an independent sum. The input to make-accumulator should specify the initial value of the sum; for example

;; (define A (make-accumulator 5))
;; (A 10)
;; 15
;; (A 10)
;; 25

(define (make-accumulator sum)
  (lambda(arg)
    (begin
      (set! sum (+ sum arg))
      sum)))

(define A (make-accumulator 5))

(display (A 10)) (newline)
(display (A 10)) (newline)



sicp exercise 2.92 2.93 2.94 2.95 2.96 2.97



;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;                        ;;
;;     Coming Soon        ;;
;;                        ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;


sicp exercise 2.87 2.88 2.89 2.90 2.91




;; Exercise 2.87.  Install =zero? for polynomials in the generic arithmetic package. This will allow adjoin-term to work for polynomials with coefficients that are themselves polynomials.



(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))


(define (install-polynomial-package)
  ;; internal procedures
  ;; representation of poly

  (define (make-poly variable term-list)
    (cons variable term-list))
  (define (variable p) (car p))
  (define (term-list p) (cdr p))
  (define (variable? x) (symbol? x))
  (define (same-variable? v1 v2)
    (and (variable? v1) (variable? v2) (eq? v1 v2)))

  ;; representation of terms and term lists
  (define (adjoin-term term term-list)
    (if (=zero? (coeff term))
        term-list
        (cons term term-list)))
  (define (the-empty-termlist) '())
  (define (first-term term-list) (car term-list))
  (define (rest-terms term-list) (cdr term-list))
  (define (empty-termlist? term-list) (null? term-list))
  (define (make-term order coeff) (list order coeff))
  (define (order term) (car term))
  (define (coeff term) (cadr term))

  (define (add-terms L1 L2)
    (cond ((empty-termlist? L1) L2)
          ((empty-termlist? L2) L1)
          (else
           (let ((t1 (first-term L1)) (t2 (first-term L2)))
             (cond ((> (order t1) (order t2))
                    (adjoin-term
                     t1 (add-terms (rest-terms L1) L2)))
                   ((< (order t1) (order t2))
                    (adjoin-term
                     t2 (add-terms L1 (rest-terms L2))))
                   (else
                    (adjoin-term
                     (make-term (order t1)
                                (add (coeff t1) (coeff t2)))
                     (add-terms (rest-terms L1)
                                (rest-terms L2)))))))))
  (define (mul-terms L1 L2)
    (if (empty-termlist? L1)
        (the-empty-termlist)
        (add-terms (mul-term-by-all-terms (first-term L1) L2)
                   (mul-terms (rest-terms L1) L2))))
  (define (mul-term-by-all-terms t1 L)
    (if (empty-termlist? L)
        (the-empty-termlist)
        (let ((t2 (first-term L)))
          (adjoin-term
           (make-term (+ (order t1) (order t2))
                      (mul (coeff t1) (coeff t2)))
           (mul-term-by-all-terms t1 (rest-terms L))))))
  (define (add-poly p1 p2)
    (if (same-variable? (variable p1) (variable p2))
        (make-poly (variable p1)
                   (add-terms (term-list p1)
                              (term-list p2)))
        (error "Polys not in same var -- ADD-POLY"
               (list p1 p2))))
  (define (mul-poly p1 p2)
    (if (same-variable? (variable p1) (variable p2))
        (make-poly (variable p1)
                   (mul-terms (term-list p1)
                              (term-list p2)))
        (error "Polys not in same var -- MUL-POLY"
               (list p1 p2))))

  (define (=zerop? p)
    (empty-termlist? (coeff p)))

  ;; interface to rest of the system
  (define (tag p) (attach-tag 'polynomial p))
  (put 'add '(polynomial polynomial)
       (lambda (p1 p2) (tag (add-poly p1 p2))))
  (put 'mul '(polynomial polynomial)
       (lambda (p1 p2) (tag (mul-poly p1 p2))))
  (put '=zero? '(polynomial) =zerop? )
  (put 'make 'polynomial
       (lambda (var terms) (tag (make-poly var terms))))
  'done)

(define (make-poly variable . terms)
  ((get 'make 'polynomial) variable terms))
(define (make-term order coeff) (list order coeff))


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


;;
;;  testing
;;

(define mypoly1 (make-poly 'x (make-term 3 4) (make-term 2 9)))
(display mypoly1) (newline)
(define mypoly2 (make-poly 'x (make-term 7 3) (make-term 3 8)))
(display mypoly2) (newline)

(display (add mypoly1 mypoly2)) (newline)
(display (mul mypoly1 mypoly2)) (newline)

(define mypoly_advanced (make-poly 'y (make-term 5 mypoly1) (make-term 3 mypoly2)))
(display mypoly_advanced) (newline)


(display (add mypoly_advanced mypoly_advanced)) (newline)

(display "------------") (newline)
(define x (make-complex-from-real-imag 1 2))
(define y (make-complex-from-real-imag 1 -2))
(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)