felixm/SICP
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Implement 2.92

Browse Source 
That was a hard one. The code is not the cleanest, but I am happy that I
was able to get it done. Let's get this chapter done.
This commit is contained in:
Felix Martin 2020-12-02 13:27:09 -05:00
parent 443665a099
commit 47e979a30c
1 changed files with 42 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

61
ex-2_77-97.scm
View File

@ -728,7 +728,7 @@
((get 'first-term (type-tag term-list)) (contents term-list))) ((get 'first-term (type-tag term-list)) (contents term-list)))
(define (adjoin-term term term-list) (define (adjoin-term term term-list)
;(display "ADJOIN-TERM ") (display term) (display term-list) (newline) ; (display "ADJOIN-TERM ") (display term) (display term-list) (newline)
((get 'adjoin-term (type-tag term-list)) term (contents term-list))) ((get 'adjoin-term (type-tag term-list)) term (contents term-list)))
;; sparse implementations ;; sparse implementations
@ -788,7 +788,7 @@
(define (coeff term) (cadr term)) (define (coeff term) (cadr term))
(define (add-terms L1 L2) (define (add-terms L1 L2)
;(display "ADD-TERMS ") (display L1) (display L2) (newline) ; (display "ADD-TERMS ") (display L1) (display L2) (newline)
(cond ((empty-termlist? L1) L2) (cond ((empty-termlist? L1) L2)
((empty-termlist? L2) L1) ((empty-termlist? L2) L1)
(else (else
@ -818,23 +818,49 @@
(else (error "Coercion not supported -- GET-COERCION-TARGET" (else (error "Coercion not supported -- GET-COERCION-TARGET"
(list p1 p2)))))) (list p1 p2))))))
(define (coerce-terms terms target-var) (define (scale-terms factor terms)
(display "COERCE-TERMS ") (display terms) (newline) ; (display "SCALE-TERMS ") (display factor) (display terms) (newline)
(define (coerce-term t)
(display "COERCE-TERM ") (display t) (newline)
; XXX: implement this
(make-term (order t) 1))
(if (empty-termlist? terms) (if (empty-termlist? terms)
terms terms
(adjoin-term (coerce-term (first-term terms)) (let ((term (first-term terms))
(coerce-terms (rest-terms terms) target-var)))) (rest (rest-terms terms)))
(adjoin-term (make-term (order term) (mul (coeff term) factor))
(scale-terms factor rest)))))
(put 'mul '(scheme-number polynomial)
(lambda (s p) (tag (make-poly (variable p)
(scale-terms s (term-list p))))))
(define (coerce-terms terms source-var target-var)
; (display "COERCE-TERMS ") (display terms) (newline)
(define (coerce-term t)
; (display "COERCE-TERM ") (display t) (newline)
(let ((c (coeff t))
(o (order t))
(new-poly (tag (make-poly-dense
source-var
(list (list (order t) 1))))))
; (display "NEW-POLY ") (display new-poly) (newline)
(if (eq? (type-tag c) 'polynomial)
(let ((new-poly (tag (make-poly-dense source-var (list (list o 1))))))
(scale-terms new-poly (contents (term-list c))))
(let ((sub-poly (tag (make-poly-dense
source-var
(list (list o c))))))
(cons 'dense (list (list 0 sub-poly)))))))
(if (empty-termlist? terms)
terms
(add-terms (coerce-term (first-term terms))
(coerce-terms (rest-terms terms) source-var target-var))))
(define (coerce-poly p target-var) (define (coerce-poly p target-var)
(display "COERCE-POLY ") (display p) (newline) ; (display "COERCE-POLY ") (display p) (newline)
(if (eq? (variable p) target-var) (if (eq? (variable p) target-var)
p p
(make-poly target-var (coerce-terms (term-list p) target-var)))) (let ((coercion-result (coerce-terms (term-list p) (variable p) target-var)))
; (display "COERCE-POLY-RESULT ") (display coercion-result) (newline)
(make-poly target-var coercion-result))))
(define (coerce-polys p1 p2) (define (coerce-polys p1 p2)
(let ((coercion-target-variable (get-coercion-target p1 p2))) (let ((coercion-target-variable (get-coercion-target p1 p2)))
@ -844,15 +870,12 @@
#f))) #f)))
(define (add-poly p1 p2) (define (add-poly p1 p2)
;(display "ADD-POLY ") (display p1) (display p2) (newline) ; (display "ADD-POLY ") (display p1) (display p2) (newline)
(if (same-variable? (variable p1) (variable p2)) (if (same-variable? (variable p1) (variable p2))
(make-poly (variable p1) (make-poly (variable p1)
(add-terms (term-list p1) (add-terms (term-list p1)
(term-list p2))) (term-list p2)))
(let ((coerced-polys (coerce-polys p1 p2))) (let ((coerced-polys (coerce-polys p1 p2)))
(display "COERCED-POLYS ") (newline)
(display "1 ") (display (car coerced-polys)) (newline)
(display "2 ") (display (cadr coerced-polys)) (newline)
(if coerced-polys (if coerced-polys
(add-poly (car coerced-polys) (cadr coerced-polys)) (add-poly (car coerced-polys) (cadr coerced-polys))
(error "Polys not in same var -- ADD-POLY" (error "Polys not in same var -- ADD-POLY"
@ -1004,9 +1027,9 @@
'((2 1) (0 1))))))) '((2 1) (0 1)))))))
(define p2 (make-poly-dense (define p2 (make-poly-dense
'y 'y
(list (list 2 (make-poly-dense (list
'x (list 4 3)
'((2 1) (0 1))))))) (list 2 (make-poly-dense 'x '((2 1) (0 8)))))))
(display (add p1 p2)) (newline) (display (add p1 p2)) (newline)