From 07e01a0483cc4ecec62031712b8d4d318ef078d8 Mon Sep 17 00:00:00 2001 From: Felix Martin Date: Fri, 27 Nov 2020 11:46:08 -0500 Subject: [PATCH] Implement till 2.90 --- ex-2_77-97.scm | 114 +++++++++++++++++++++++++++++++++++++------------ 1 file changed, 87 insertions(+), 27 deletions(-) diff --git a/ex-2_77-97.scm b/ex-2_77-97.scm index 4d79c2f..733cd43 100644 --- a/ex-2_77-97.scm +++ b/ex-2_77-97.scm @@ -254,7 +254,8 @@ (and (equ? (magnitude z1) (magnitude z2)) (equ? (angle z1) (angle z2)))) (define (negate-complex z) - (tag (make-from-real-imag (- (real-part z)) (- (imag-part z))))) + (tag (make-from-real-imag (negate (real-part z)) + (negate (imag-part z))))) (define (complex->real x) (make-real (real-part x))) ;; interface to rest of the system @@ -701,16 +702,15 @@ (define p2 (make-poly 'x (list (list 5 2) (list 2 (make-rational 1 2))))) (assert (sub p1 p2) p2) -(display "\nex-2.89 - spare representation\n") +(display "\nex-2.89 - sparse representation\n") -(define (install-polynomial-sparse-representation-package) +(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 (make-poly variable term-list) + (cons variable term-list)) ;; procedures same-variable? and variable? from section 2.3.2 (define (variable? x) (symbol? x)) @@ -719,22 +719,63 @@ (define (same-variable? v1 v2) (and (variable? v1) (variable? v2) (eq? v1 v2))) + ;; generic implementations (define (first-term term-list) + ((get 'first-term (type-tag term-list)) (contents term-list))) + + (define (adjoin-term term term-list) + ;(display "ADJOIN-TERM ") (display term) (display term-list) (newline) + ((get 'adjoin-term (type-tag term-list)) term (contents term-list))) + + ;; sparse implementations + (define (tag-sparse p) (attach-tag 'sparse p)) + (define (make-poly-sparse variable term-list) + (cons variable (tag-sparse term-list))) + + (define (first-term-sparse term-list) + ;(display "first-term-sparse ") (display term-list) (newline) (make-term (- (length term-list) 1) (car term-list))) - (define (adjoin-term term term-list) + (define (adjoin-term-sparse term term-list) (let ((coeff-term (coeff term)) (order-term (order term)) (length-terms (length term-list))) (cond - ((= order-term length-terms) (cons coeff-term term-list)) + ((= order-term length-terms) (tag-sparse (cons coeff-term term-list))) ((< order-term length-terms) (error "Cannot adjoin lower-order term to terms")) - (else (cons coeff-term (adjoin-term (make-term (- order-term 1) 0) term-list)))))) + (else (tag-sparse + (cons + coeff-term + (contents (adjoin-term-sparse + (make-term (- order-term 1) 0) + term-list)))))))) - (define (the-empty-termlist) '()) - (define (rest-terms term-list) (cdr term-list)) - (define (empty-termlist? term-list) (null? term-list)) + (put 'first-term 'sparse first-term-sparse) + (put 'adjoin-term 'sparse adjoin-term-sparse) + + ;; dense implementations + (define (tag-dense p) (attach-tag 'dense p)) + (define (make-poly-dense variable term-list) + (cons variable (tag-dense term-list))) + + (define (adjoin-term-dense term term-list) + (if (=zero? (coeff term)) + (tag-dense term-list) + (tag-dense (cons term term-list)))) + + (define (first-term-dense term-list) (car term-list)) + + (put 'first-term 'dense first-term-dense) + (put 'adjoin-term 'dense adjoin-term-dense) + + (define (the-empty-termlist) (tag-sparse '())) + (define (rest-terms term-list) + (let ((term-type (type-tag term-list)) + (terms (contents term-list))) + (attach-tag term-type (cdr terms)))) + + (define (empty-termlist? term-list) (null? (contents term-list))) (define (make-term order coeff) (list order coeff)) (define (order term) (car term)) (define (coeff term) (cadr term)) @@ -777,13 +818,13 @@ (define (mul-terms L1 L2) (if (empty-termlist? L1) - (the-empty-termlist) + L1 (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) + L (let ((t2 (first-term L))) (adjoin-term (make-term (+ (order t1) (order t2)) @@ -815,25 +856,44 @@ (put 'sub '(polynomial polynomial) (lambda (p1 p2) (tag (sub-poly p1 p2)))) (put '=zero? '(polynomial) =zero?-poly) - (put 'make 'polynomial - (lambda (var terms) (tag (make-poly var terms)))) - (display "[install-polynomial-sparse-representation-package]\n") + (put 'make 'poly-sparse + (lambda (var terms) (tag (make-poly-sparse var terms)))) + (put 'make 'poly-dense + (lambda (var terms) (tag (make-poly-dense var terms)))) + (display "[install-polynomial-package]\n") 'done) -(install-polynomial-sparse-representation-package) +(install-polynomial-package) -(define p1 (make-poly 'x (list 5 1))) -(assert (add p1 p1) (make-poly 'x (list 10 2))) -(assert (add (make-poly 'x (list 2 2 0 1)) - (make-poly 'x (list 1 2 3 2 3 6 6))) - (make-poly 'x (list 1 2 3 4 5 6 7))) -(display (mul (make-poly 'x (list 1 1)) - (make-poly 'x (list 1 1)))) +(define (make-poly-sparse var terms) + ((get 'make 'poly-sparse) var terms)) + +(define (make-poly-dense var terms) + ((get 'make 'poly-dense) var terms)) -;(display "\nex-2.90\n") +(define p1 (make-poly-sparse 'x (list 5 1))) +(display p1) (newline) +(display (add p1 p1)) (newline) -;(display "\nex-2.91\n") +(assert (add p1 p1) (make-poly-sparse 'x (list 10 2))) +(assert (add (make-poly-sparse 'x (list 2 2 0 1)) + (make-poly-sparse 'x (list 1 2 3 2 3 6 6))) + (make-poly-sparse 'x (list 1 2 3 4 5 6 7))) +(assert (mul (make-poly-sparse 'x (list 1 1)) + (make-poly-sparse 'x (list 1 1))) + (make-poly-sparse 'x (list 1 2 1))) + +(display "\nex-2.90 - support sparse and dense polynomials\n") + +(define p (make-poly-dense 'x '((100 2) (1 2)))) +(display p) (newline) +(assert (add p p) (make-poly-dense 'x '((100 4) (1 4)))) +(assert (mul p p) + (make-poly-dense 'x '((200 4) (101 8) (2 4)))) + + +(display "\nex-2.91\n") ;(display "\nex-2.92\n")