ompayne
/
sicp
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Get sparse polynomials working (plus a tidy up)

This commit is contained in:
Oliver Payne 2022-04-03 21:51:52 +01:00
parent 90a8f06e3c
commit 3ec8012338
1 changed files with 67 additions and 58 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

125
2_78.rkt
View File

@ -500,7 +500,7 @@
(put 'mul '(polynomial polynomial)
(lambda (p1 p2) (tag (mul-poly p1 p2))))
(put 'negate '(polynomial)
(lambda (p) (tag (negate-poly))))
(lambda (p) (tag (negate-poly p))))
(put '=zero? '(polynomial)
(lambda (p) (empty-termlist? (term-list p))))
@ -512,13 +512,6 @@
(define (tag l) (attach-tag 'termlist l))
(define (make-sparse terms)
(tag ((get 'make 'sparse) terms)))
(define (make-dense terms)
(tag ((get 'make 'dense) terms)))
(define (the-empty-termlist) '())
(define (add-terms L1 L2)
(cond ((empty-termlist? L1) L2)
((empty-termlist? L2) L1)
@ -534,26 +527,57 @@
(adjoin-term
(make-term (order t1)
(add (coeff t1) (coeff t2)))
(add (tag (rest-terms L1))
(tag (rest-terms L2))))))))))
(add-terms (rest-terms L1)
(rest-terms L2)))))))))
(define (mul-terms L1 L2)
(if (empty-termlist? L1)
(the-empty-termlist)
(add (mul-term-by-all-terms (first-term L1) L2)
(mul (tag (rest-terms L1))
(tag L2)))))
((get 'the-empty-termlist (type-tag L2)))
(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)
((get 'the-empty-termlist (type-tag L)))
(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))))))
;; Constructors
(put 'make-sparse-empty-termlist 'termlist
(lambda ()
(tag ((get 'the-empty-termlist 'sparse)))))
(put 'make-sparse-termlist 'termlist
(lambda (term)
(tag ((get 'make-from-term 'sparse) term))))
(put 'make-dense-empty-termlist 'termlist
(lambda ()
(tag ((get 'the-empty-termlist 'dense)))))
(put 'make-dense-termlist 'termlist
(lambda (term)
(tag ((get 'make-from-term 'dense) term))))
;; Term will have its tag removed by apply-generic. This needs to be
;; re-added for the next apply-generic call (needed to step into the
;; appropriate termlist implementation).
(put 'adjoin-term '(term termlist)
(lambda (term termlist)
(tag
(adjoin-term (apply make-term term)
termlist))))
;; Selectors
(put 'first-term '(termlist) first-term)
(put 'rest-terms '(termlist)
(lambda (termlist)
(tag (rest-terms termlist))))
(put 'empty-termlist? '(termlist) empty-termlist?)
;; Operators
(put 'add '(termlist termlist)
(lambda (L1 L2)
(tag (add-terms L1 L2))))
@ -562,38 +586,18 @@
(lambda (L1 L2)
(tag (mul-terms L1 L2))))
(put 'first-term '(termlist) first-term)
(put 'rest-terms '(termlist)
(lambda (termlist)
(tag (rest-terms termlist))))
(put 'empty-termlist? '(termlist) empty-termlist?)
;; Term will have its tag removed by apply-generic. This needs to be
;; re-added for the next apply-generic call (needed to step into the
;; appropriate termlist implementation).
(put 'adjoin-term '(term termlist)
(lambda (term termlist)
(adjoin-term (apply make-term term)
termlist)))
(put 'make-sparse-termlist 'termlist
make-sparse)
(put 'make-dense-termlist 'termlist
make-dense)
(put 'negate '(termlist)
(lambda (L)
(tag (negate L))))
(put 'the-empty-termlist 'termlist
the-empty-termlist)
'done)
(define (install-sparse-package)
;; NB assume that terms are ordered by decreasing term order
(define (make-termlist terms)
(if (null? terms)
(the-empty-termlist)
(adjoin-term (car terms)
(make-termlist (cdr terms)))))
;; Make a termlist from a single term
(define (make-termlist term)
(list (contents term)))
;; representation of terms and term lists
;;[procedures adjoin-term ... coeff from text below]
(define (adjoin-term term term-list)
@ -601,23 +605,25 @@
term-list
(cons (contents term) term-list)))
(define (the-empty-termlist) '())
(define (empty-termlist? term-list) (null? term-list))
(define (negate-termlist term-list)
(map (lambda (t) (list (car t) (negate (cadr t))))
term-list))
(define (the-empty-termlist) '())
(define (empty-termlist? l) (null? l))
(define (tag l) (attach-tag 'sparse l))
(put 'make 'sparse
(lambda (terms) (tag (make-termlist terms))))
;; Constructors
(put 'make-from-term 'sparse
(lambda (term) (tag (make-termlist term))))
(put 'the-empty-termlist 'sparse
(lambda () (tag (the-empty-termlist))))
(put 'adjoin-term '(term sparse)
(lambda (term termlist)
(tag (adjoin-term (apply make-term term) termlist))))
(put 'empty-termlist? '(sparse) empty-termlist?)
(put 'the-empty-termlist '(sparse)
(lambda ()
(tag (the-empty-termlist))))
;; Selectors
(put 'first-term '(sparse)
(lambda (termlist)
(if (pair? termlist)
@ -626,9 +632,11 @@
(make-term 0 0))))
(put 'rest-terms '(sparse)
(lambda (termlist)
(if (pair? termlist)
(tag (cdr termlist))
(the-empty-termlist))))
(tag (cdr termlist))))
(put 'empty-termlist? '(sparse) empty-termlist?)
;; Operators
(put 'negate '(sparse)
(lambda (termlist)
(tag (negate-termlist termlist))))
@ -677,11 +685,14 @@
(define (make-sparse-termlist sparse-terms)
((get 'make-sparse-termlist 'termlist) sparse-terms))
(define (make-sparse-empty-termlist)
((get 'make-sparse-empty-termlist 'termlist)))
(define (make-dense-termlist dense-terms)
((get 'make-dense-termlist 'termlist) dense-terms))
(define (the-empty-termlist)
(get 'the-empty-termlist 'termlist))
(define (make-dense-empty-termlist)
((get 'make-dense-empty-termlist 'termlist)))
;; Generic selectors
@ -779,9 +790,7 @@
(define (coeff-dense term) (cadr term))
(define first-term-dense car)
(define (rest-terms-dense term-list)
(if (pair? term-list)
(cdr term-list)
the-empty-termlist))
(cdr term-list))
(define (make-termlist-dense coeffs)
(cond ((null? coeffs) '())
((= 0 (car coeffs))