# SICP 2.5 exercises cont. 5

**Posted:**March 18, 2013

**Filed under:**Improving, SICP, Uncategorized Leave a comment

**2.91**

Made some heavy changes to the dense polynomial package to get it working. A bit frustrating, but this was great to get back into the groove. I only implemented division for dense polynomials, maybe I’ll go back and do sparse polynomials in the future.

(define (install-dense-polynomial-package) (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 (div-poly p1 p2) (if (same-variable? (variable p1) (variable p2)) (make-poly (variable p1) (div-terms (term-list p1) (term-list p2))) (error "Polys not in same var -- DIV-POLY" (list p1 p2)))) ;; internal procedures ;; representation of poly (define (make-poly variable term-list) (cons variable term-list)) (define (variable p) (car p)) (define (variable? x) (symbol? x)) (define (term-list p) (cdr p)) (define (same-variable? v1 v2) (and (variable? v1) (variable? v2) (eq? v1 v2))) (define (adjoin-term term term-list) (cons term term-list)) (define (the-empty-termlist) '()) (define (first-term term-list) (make-term (length 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) ((> (length L1) (length L2)) (adjoin-term (coeff (first-term L1)) (add-terms (rest-terms L1) L2))) (( (order t2) (order t1)) (list (the-empty-termlist) L1) (let ((new-c (div (coeff t1) (coeff t2))) (new-o (- (order t1) (order t2)))) (display t1) (display t2) (display new-o) (display (term2terms (make-term new-o new-c))) (newline) (newline) (let ((rest-of-result (div-terms (trim (add-terms L1 (negate-terms (mul-terms (term2terms (make-term new-o new-c)) L2)))) L2))) (list (add-terms (car rest-of-result) (term2terms (make-term new-o new-c))) (cadr rest-of-result)))))))) (define (negate-poly p) (make-poly (variable p) (negate-terms (term-list p)))) ;; interface to rest of the system (define (tag p) (attach-tag 'dense p)) (put 'add '(dense dense) (lambda (p1 p2) (tag (add-poly p1 p2)))) (put 'mul '(dense dense) (lambda (p1 p2) (tag (mul-poly p1 p2)))) (put 'div '(dense dense) (lambda (p1 p2) (tag (div-poly p1 p2)))) (put 'make 'dense (lambda (var terms) (tag (make-poly var terms)))) (put '=zero? '(dense) (lambda (p) (zero-terms? (term-list p)))) (put 'negate '(dense) (lambda (p) (tag (negate-poly p)))) 'done) (define (negate x) (apply-generic 'negate x)) (define (sub x y) (add x (negate y))) (define (install-polynomial-package) (define (make-dense-proc var terms) ((get 'make 'dense) var terms)) (define (make-sparse-proc var terms) ((get 'make 'sparse) var terms)) (define (tag p) (attach-tag 'polynomial p)) (put 'add '(polynomial polynomial) (lambda (p1 p2) (tag (add p1 p2)))) (put 'mul '(polynomial polynomial) (lambda (p1 p2) (tag (mul p1 p2)))) (put 'div '(polynomial polynomial) (lambda (p1 p2) (tag (div p1 p2)))) (put 'sub '(polynomial polynomial) (lambda (p1 p2) (tag (sub p1 p2)))) (put 'negate '(polynomial) (lambda (p) (tag (negate p)))) (put 'make-dense 'polynomial (lambda (var terms) (tag (make-dense-proc var terms)))) (put 'make-sparse 'polynomial (lambda (var terms) (tag (make-sparse-proc var terms)))))

# Still Busy

**Posted:**March 14, 2013

**Filed under:**Uncategorized Leave a comment

Well, I’ve completely failed my New Year’s Resolution at this point. I’ll just summarize some things I’ve been doing.

– Research: Been progressing. What’s interesting is that through my work I’ve had a lot of practice working with tree structures. I also started using Postgres which has been great. At this point it’s my favorite relational database.

– C practice: I feel like my C skills have been stagnating so I did some simple exercises like implementing linked lists and binary trees. Nothing too interesting, but it’s been great for reinforcing my knowledge of C and especially pointer and memory management.

– Various tech: I’ve been going over technologies like LLVM, Twisted, and Ruby on Rails for fun. They’re all things I want to eventually sit down and put time an effort into learning properly but for now I’m just randomly dabbling.

# SICP 2.5 exercises cont. 4

**Posted:**February 27, 2013

**Filed under:**Uncategorized Leave a comment

**2.90**

This took a really long time. Not only was I very busy with school and work, but also I kept getting lost in my code when I could actually spare some time. Here I repost a lot of the code from the previous exercise. Changes include the addition of public make polynomial methods, and new procedures and tags to the dense and sparse polynomial packages. Finally a general install-polynomial package is implemented

(define (make-dense-polynomial var terms) ((get 'make-dense 'polynomial) var terms)) (define (make-sparse-polynomial var terms) ((get 'make-sparse 'polynomial) var terms)) (define (install-sparse-polynomial-package) (define (add-poly p1 p2) (display (list (variable p1) (variable p2))) (newline) (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)))) ;; internal procedures ;; representation of poly (define (make-poly variable term-list) (cons variable term-list)) (define (variable p) (car p)) (define (variable? x) (symbol? x)) (define (term-list p) (cdr p)) (define (same-variable? v1 v2) (and (variable? v1) (variable? v2) (eq? v1 v2))) (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))) (( (length L1) (length L2)) (adjoin-term (first-term L1) (add-terms (rest-terms L1) L2))) ((< (length L1) (length L2)) (adjoin-term (first-term L2) (add-terms L1 (rest-terms L2)))) (else (let ((t1 (first-term L1)) (t2 (first-term L2))) (adjoin-term (+ t1 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 (length L1) (car L1) L2) (mul-terms (rest-terms L1) L2)))) (define (mul-term-by-all-terms t1-order t1-coeff L) (cond ((and (= t1-order 1) (empty-termlist? L)) (the-empty-termlist)) ((empty-termlist? L) (cons 0 (mul-term-by-all-terms (- t1-order 1) t1-coeff L))) (else (cons (* t1-coeff (car L)) (mul-term-by-all-terms t1-order t1-coeff (cdr L)))))) (define (zero-terms? term-list) (cond ((empty-termlist? term-list) #t) ((not (= 0 (coeff (first-term term-list)))) #f) (else (zero-terms? (rest-terms term-list))))) (define (negate-terms term-list) (if (empty-termlist? term-list) (the-empty-termlist) (cons (- (first-term term-list)) (negate-terms (rest-terms term-list))))) (define (negate-poly p) (make-polynomial (variable p) (negate-terms (term-list p)))) ;; interface to rest of the system (define (tag p) (attach-tag 'dense p)) (put 'add '(dense dense) (lambda (p1 p2) (tag (add-poly p1 p2)))) (put 'mul '(dense dense) (lambda (p1 p2) (tag (mul-poly p1 p2)))) (put 'make 'dense (lambda (var terms) (tag (make-poly var terms)))) (put '=zero? '(dense) (lambda (p) (zero-terms? (term-list p)))) (put 'negate '(dense) negate-poly) 'done) (define (install-polynomial-package) (define (make-dense-proc var terms) ((get 'make 'dense) var terms)) (define (make-sparse-proc var terms) ((get 'make 'sparse) var terms)) (define (tag p) (attach-tag 'polynomial p)) (put 'add '(polynomial polynomial) (lambda (p1 p2) (tag (add p1 p2)))) (put 'mul '(polynomial polynomial) (lambda (p1 p2) (tag (mul p1 p2)))) (put 'sub '(polynomial polynomial) (lambda (p1 p2) (tag (sub p1 p2)))) (put 'negate '(polynomial) negate) (put 'make-dense 'polynomial (lambda (var terms) (tag (make-dense-proc var terms)))) (put 'make-sparse 'polynomial (lambda (var terms) (tag (make-sparse-proc var terms)))))

The results are what I wanted but I am quite muddled. Going to move on but perhaps I’ll revisit this later.

# Busy Busy

**Posted:**February 22, 2013

**Filed under:**Uncategorized Leave a comment

So I haven’t posted anything in two weeks because real world commitments are demanding much of my attention. In between research work, schoolwork, and job search, I’ve been finding it very difficult to focus on anything else.

# SICP 2.5 exercises cont. 3

**Posted:**February 12, 2013

**Filed under:**Improving, SICP 4 Comments

**2.89**

(define (install-dense-polynomial-package) (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)))) ;; internal procedures ;; representation of poly (define (make-poly variable term-list) (cons variable term-list)) (define (variable p) (car p)) (define (variable? x) (symbol? x)) (define (term-list p) (cdr p)) (define (same-variable? v1 v2) (and (variable? v1) (variable? v2) (eq? v1 v2))) (define (adjoin-term 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) ((> (length L1) (length L2)) (adjoin-term (first-term L1) (add-terms (rest-terms L1) L2))) ((< (length L1) (length L2)) (adjoin-term (first-term L2) (add-terms L1 (rest-terms L2)))) (else (let ((t1 (first-term L1)) (t2 (first-term L2))) (adjoin-term (+ t1 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 (length L1) (car L1) L2) (mul-terms (rest-terms L1) L2)))) (define (mul-term-by-all-terms t1-order t1-coeff L) (cond ((and (= t1-order 1) (empty-termlist? L)) (the-empty-termlist)) ((empty-termlist? L) (cons 0 (mul-term-by-all-terms (- t1-order 1) t1-coeff L))) (else (cons (* t1-coeff (car L)) (mul-term-by-all-terms t1-order t1-coeff (cdr L)))))) (define (zero-terms? term-list) (cond ((empty-termlist? term-list) #t) ((not (= 0 (coeff (first-term term-list)))) #f) (else (zero-terms? (rest-terms term-list))))) (define (negate-terms term-list) (if (empty-termlist? term-list) (the-empty-termlist) (cons (- (first-term term-list)) (negate-terms (rest-terms term-list))))) (define (negate-poly p) (make-polynomial (variable p) (negate-terms (term-list 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 'make 'polynomial (lambda (var terms) (tag (make-poly var terms)))) (put '=zero? '(polynomial) (lambda (p) (zero-terms? (term-list p)))) (put 'negate '(polynomial) negate-poly) 'done)

Slow progress now, but these are challenging exercises and I’m behind on a lot of real life work.

# SICP 2.5 exercises cont. 2

**Posted:**February 10, 2013

**Filed under:**Improving, SICP Leave a comment

**2.87**

(define (zero-terms? term-list) (cond ((empty-termlist? term-list) #t) ((not (= 0 (coeff (first-term term-list)))) #f) (else (zero-terms? (rest-terms term-list))))) (put '=zero? '(polynomial) (lambda (p) (zero-terms? (term-list p))))

Decently straightforward.

**2.88**

Define subtraction in terms of generic add and generic negate. Then implement the negation for polynomials.

(define (sub x y) (add x (negate y))) (define (negate-terms term-list) (if (empty-termlist? term-list) (the-empty-termlist) (cons (make-term (order (first-term term-list)) (- (coeff (first-term term-list)))) (negate-terms (rest-terms term-list))))) (define (negate-poly p) (make-polynomial (variable p) (negate-terms (term-list p))))

It’s Chinese New Year so I had some stuff to do, like eating lots.

# SICP 2.5 exercises cont.

**Posted:**February 9, 2013

**Filed under:**Improving, SICP Leave a comment

**2.81**

a) apply-generic will continue to call itself because at the coercion step, it will call itself with the exact same values as before.

b) There is no need to do anything because apply-generic will either raise an error if there is no procedure that deals with the type, or it will apply the procedure that was found on the arguments.

c)

(define (apply-generic op . args) (let ((type-tags (map type-tag args))) (let ((proc (get op type-tags))) (if proc (apply proc (map contents args)) (if (= (length args) 2) (let ((type1 (car type-tags)) (type2 (cadr type-tags)) (a1 (car args)) (a2 (cadr args))) (if (eq? type1 type2) (error "No method for these types" (list op type-tags)) (let ((t1->t2 (get-coercion type1 type2)) (t2->t1 (get-coercion type2 type1))) (cond (t1->t2 (apply-generic op (t1->t2 a1) a2)) (t2->t1 (apply-generic op a1 (t2->t1 a2))) (else (error "No method for these types" (list op type-tags))))))) (error "No method for these types" (list op type-tags)))))))

I don’t really get the point of this problem though.

**2.82**

This is extremely confusing even to me, but it works. Basically two helper procedures are defined. One is for coercing a list of numbers to a target type. The second procedure uses the first to coerce the list to the type of each argument. If there isn’t an available coercion procedure, then skip. When everything is coerced, attempt to apply the generic procedure on the new list immediately. This is in order to prevent an infinite loop.

(define (apply-generic op . args) (define (coerce-to target arguments) (cond ((null? arguments) '()) ((eq? (type-tag (car arguments)) target) (cons (car arguments) (coerce-to target (cdr arguments)))) (else (let ((coerce-proc (get-coercion (type-tag (car arguments)) target))) (if coerce-proc (cons (coerce-proc (car arguments)) (coerce-to target (cdr arguments))) (cons (car arguments) (coerce-to target (cdr arguments)))))))) (define (coerce-all arguments targets-left) (if (null? targets-left) arguments (coerce-all (coerce-to (car targets-left) arguments) (cdr targets-left)))) (let ((type-tags (map type-tag args))) (let ((proc (get op type-tags))) (if proc (apply proc (map contents args)) (let ((coerced-args (coerce-all args type-tags))) (if coerced-args (let ((coerce-proc (get op (map type-tag coerced-args)))) (if coerce-proc (apply coerce-proc coerced-args) (error "No method for these types" (list op type-tags))))))))))

I found a very good (but different) answer here. The part I cheated was in answering the discussion question about when the above procedure fails. Point 2 I find especially interesting. When there is only a (complex complex) operation defined, it should be possible to coerce a (scheme-number scheme-number) to it and then use the operation. However the above apply-general procedure does not do that.

**2.83**

The following go in the relevant install procedures. I skipped implementing real numbers because it isn’t in the examples and probably isn’t trivial. I suppose the raise function would not be hard to implement, but it’s no fun when it isn’t testable.

(define (scheme-number->rational n) (make-rational (contents n) 1)) (put 'raise '(scheme-number) scheme-number->rational)

(define (rational->complex n) (make-complex-from-real-imag (/ (numer n) (denom n)) 0)) (put 'raise '(rational) rational->complex)

**2.84**

(define (apply-generic op . args) (define (level-iter n current-level) (if (not (get 'raise (list (type-tag n)))) current-level (level-iter (raise n) (+ 1 current-level)))) (define (level n) (level-iter n 0)) (define (coerce args target-level) (cond ((null? args) '()) ((> (level (car args)) target-level) (coerce (cons (raise (car args)) (cdr args)) target-level)) (else (cons (car args) (coerce (cdr args) target-level))))) (let ((type-tags (map type-tag args))) (let ((proc (get op type-tags))) (if proc (apply proc (map contents args)) (let ((target-level (apply min (map level args)))) (let ((coerced-args (coerce args target-level))) (let ((coerce-proc (get op (map type-tag coerced-args)))) (if coerce-proc (apply apply-generic (cons op coerced-args)) (error "No method for these types" (list op type-tags))))))))))

This doesn’t deal with the issue in 2.83, but it’s enough to answer the question.

**2.85**

As above, the specific project procedures go inside their respective install procedures.

(put 'project '(rational) (lambda (x) (quotient (numer x) (denom x)))) (put 'project '(complex) (lambda (z) (make-rational (real-part z) 1))) (define (project n) (apply-generic 'project n)) (define (drop n) (if (not (get 'project (list (type-tag n)))) n (if (not (equ? n (raise (project n)))) n (drop (project n)))))

Once again real numbers are ignored. It’s also kind of silly because complex numbers never drop down to rational numbers without dropping to scheme-number in my code, because they are simply represented as pairs of integers. I feel I understand the general idea of this section though and I really want to move on.

**2.86**

Never mind my comments above! Turned out that the silliness was part of the exercise.

(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 r a) ((get 'make-from-mag-ang 'polar) r a)) ;; 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)))) (define (equ?-complex z1 z2) (and (equ? (real-part z1) (real-part z2)) (equ? (imag-part z1) (imag-part z2)))) (define (=zero?-complex z) (and (equ? (real-part z) 0) (equ? (imag-part z) 0))) (define (install-rational-package) ;; internal procedures (define (numer x) (car x)) (define (denom x) (cdr x)) (define (make-rat n d) (if (and (integer? n) (integer? d)) (let ((g (gcd (inexact->exact n) (inexact->exact d)))) (cons (/ n g) (/ d g)))) (cons n d)) (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)))) ;; interface to rest of the system (define (tag x) (attach-tag 'rational x)) (define (equ?-rational x y) (= (/ (numer x) (denom x)) (/ (numer y) (denom y)))) (define (rational->complex n) (make-complex-from-real-imag (tag n) 0)) (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 'make 'rational (lambda (n d) (tag (make-rat n d)))) (put 'equ? '(rational rational) equ?-rational) (put '=zero? '(rational) (lambda (x) (= 0 (numer x)))) (put 'add-3 '(rational rational rational) (lambda (z1 z2 z3) (tag (add-rat (add-rat z1 z2) z3)))) (put 'raise '(rational) rational->complex) (put 'project '(rational) (lambda (x) (quotient (inexact->exact (numer x)) (inexact->exact (denom x))))) (put 'cosine '(rational) (lambda (x) (cos (/ (numer x) (denom x))))) (put 'sine '(rational) (lambda (x) (sin (/ (numer x) (denom x))))) 'done) (define (install-scheme-number-package) (define (tag x) (attach-tag 'scheme-number x)) (define (scheme-number->rational n) (make-rational (contents n) 1)) (put 'add '(scheme-number scheme-number) (lambda (x y) (tag (+ x y)))) (put 'sub '(scheme-number scheme-number) (lambda (x y) (tag (- x y)))) (put 'mul '(scheme-number scheme-number) (lambda (x y) (tag (* x y)))) (put 'div '(scheme-number scheme-number) (lambda (x y) (tag (/ x y)))) (put 'make 'scheme-number (lambda (x) (tag x))) (put 'equ? '(scheme-number scheme-number) (lambda (x y) (= x y))) (put '=zero? '(scheme-number) (lambda (x) (= x 0))) (put 'exp '(scheme-number scheme-number) (lambda (x y) (tag (expt x y)))) ; using primitive expt (put 'add-3 '(scheme-number scheme-number scheme-number) (lambda (x y z) (+ x y z))) (put 'raise '(scheme-number) scheme-number->rational) (put 'cosine '(scheme-number) cos) (put 'sine '(scheme-number) sin) 'done) (define (cosine x) (apply-generic 'cosine x)) (define (sine x) (apply-generic 'sine x))

Just posting everything because there where a range of changes. Mostly the packages now use the generic operators instead of the native guile ones. I had to use guile’s inexact->exact procedure to keep gcd happy. The cosine and sine generic procedures are straightforward. I also edited make-rat so that decimal numerators and denominators are allowed for simplicity.