From: Ramakrishnan Muthukrishnan Date: Fri, 31 Dec 2010 08:10:16 +0000 (+0530) Subject: solutions to 2.88, 2.89 and 2.90 X-Git-Url: https://git.rkrishnan.org/?a=commitdiff_plain;h=39264b8fcff4e203786cf9b35800def2fcefce01;p=sicp.git solutions to 2.88, 2.89 and 2.90 --- diff --git a/src/sicp/ex2_88.rkt b/src/sicp/ex2_88.rkt new file mode 100644 index 0000000..55ed370 --- /dev/null +++ b/src/sicp/ex2_88.rkt @@ -0,0 +1,43 @@ +#lang racket + +(define (negate x) (- x)) + +(put 'negate '(scheme-number) + (lambda (r) (tag (negate r)))) + +(put 'negate '(rational) + (lambda (r) (tag (negate r)))) + +(put 'negate '(real) + (lambda (r) (tag (negate r)))) + +(put 'negate '(complex) + (lambda (c) (tag ((get 'make 'complex) (negate (real c)) + (negate (imag c)))))) + +(put 'negate '(polynomial) + (lambda (p) (tag (negate-poly p)))) + +(define (negate-terms terms) + (if (empty-termlist? terms) + the-empty-termlist + (let ((t1 (first-term terms))) + (let ((o (order t1)) + (c (coeff t1))) + (adjoin-term (make-term o (negate c)) + (negate-terms (rest-terms terms))))))) + +(define (negate-poly p) + (let ((terms (term-list p))) + (make-poly (variable p) (negate-terms terms)))) + +(put 'negate '(polynomial) + (lambda (p) (tag (negate-poly p)))) + +(define (negate p) (apply-generic 'negate p)) + +(define (sub-poly p1 p2) + (add-poly p1 (negate p2))) + +(put 'sub '(polynomial polynomial) + (lambda (p1 p2) (tag (sub-poly p1 p2)))) \ No newline at end of file diff --git a/src/sicp/ex2_89.rkt b/src/sicp/ex2_89.rkt new file mode 100644 index 0000000..d37a8eb --- /dev/null +++ b/src/sicp/ex2_89.rkt @@ -0,0 +1,17 @@ +#lang racket + +(define (adjoin-term term term-list) + (cons (coeff term) term-list)) + +(define (the-empty-termlist) '()) + +(define (first-term term-list) + (let ((len (length term-list))) + (make-term (- len 1) (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)) \ No newline at end of file diff --git a/src/sicp/ex2_90.rkt b/src/sicp/ex2_90.rkt new file mode 100644 index 0000000..a3c374c --- /dev/null +++ b/src/sicp/ex2_90.rkt @@ -0,0 +1,96 @@ +#lang racket + +(define (install-dense-termlist-package) + ;; internal procedures + (define (adjoin-term term term-list) + (cons (coeff term) term-list)) + (define (first-term term-list) + (let ((len (length term-list))) + (make-term (- len 1) (car term-list)))) + (define (rest-terms term-list) (cdr term-list)) + (define (the-empty-termlist) '()) + (define (empty-termlist? term-list) (null? term-list)) + ;; interface to the rest of the system + (define (tag x) (attach-tag 'dense x)) + (put 'adjoin-term '(term dense) + (lambda (term term-list) + (tag (adjoin-term term term-list)))) + (put 'first-term '(dense) first-term) + (put 'rest-terms '(dense) + (lambda (term-list) + (tag (rest-terms term-list)))) + (put 'the-empty-termlist '(dense) + (lambda () + (tag (the-empty-termlist)))) + (put 'empty-termlist? '(dense) + (lambda (tl) + (empty-termlist? (contents tl)))) + 'done) + +(define (install-sparse-termlist-package) + ;; internal procedures + (define (adjoin-term term term-list) + (if (=zero? (coeff term)) + term-list + (cons (coeff term) term-list))) + (define (first-term term-list) (car term-list)) + (define (rest-terms term-list) (cdr term-list)) + (define (the-empty-termlist) '()) + (define (empty-termlist? term-list) (null? term-list)) + + ;; interface to the rest of the system + (define (tag x) (attach-tag 'sparse x)) + (put 'adjoin-term '(term sparse) + (lambda (term term-list) + (tag (adjoin-term term term-list)))) + (put 'first-term '(sparse) first-term) + (put 'rest-terms '(sparse) + (lambda (term-list) + (tag (rest-terms term-list)))) + (put 'the-empty-termlist '(sparse) + (lambda () + (tag (the-empty-termlist)))) + (put 'empty-termlist? '(sparse) + (lambda (tl) + (empty-termlist? (contents tl)))) + 'done) + +(define (install-term-package) + (define (make-term order coeff) (list order coeff)) + (define (order term) (car term)) + (define (coeff term) (cadr term)) + + (define (tag x) (attach-tag 'term x)) + (put 'make-term '(scheme-number scheme-number) + (lambda (o c) + (tag (make-term o c)))) + (put 'order '(term) + (lambda (t) + (order (contents t)))) + (put 'coeff '(term) + (lambda (t) + (coeff (contents t)))) + 'done) + +;; generic procedures +(define (adjoin-term term terms) (apply-generic 'adjoin-term term terms)) +(define (first-term term-list) (apply-generic 'first-term term-list)) +(define (rest-terms term-list) (apply-generic 'rest-terms term-list)) +(define (empty-termlist? tl) (apply-generic 'empty-termlist? tl)) + +(define (make-term order coeff) (apply-generic 'make-term order coeff)) +(define (order term) (apply-generic 'order term)) +(define (coeff term) (apply-generic 'coeff term)) + +#| + +the-empty-termlist needs special treatment because it has no input. This can be remedied +by get'ing the right empty term list using: + + (get 'the-empty-termlist '(sparse)) + +or + + (get 'the-empty-termlist '(dense)) + +|#