diff options
| -rw-r--r-- | coding-exercises/2/78/install-complex-package.rkt | 3 | ||||
| -rw-r--r-- | coding-exercises/2/83/install-rational.rkt | 3 | ||||
| -rw-r--r-- | coding-exercises/2/83/install-real.rkt | 1 | ||||
| -rw-r--r-- | coding-exercises/2/83/install.rkt | 2 | ||||
| -rw-r--r-- | coding-exercises/2/87.rkt | 156 |
5 files changed, 132 insertions, 33 deletions
diff --git a/coding-exercises/2/78/install-complex-package.rkt b/coding-exercises/2/78/install-complex-package.rkt index e332351..335eacd 100644 --- a/coding-exercises/2/78/install-complex-package.rkt +++ b/coding-exercises/2/78/install-complex-package.rkt @@ -53,6 +53,9 @@ (put 'add '(complex complex) (lambda (z1 z2) (typetag (add-complex z1 z2)))) + (put 'neg '(complex) + (lambda (z) (typetag (make-from-real-imag (- (real-part z)) + (- (imag-part z)))))) (put 'sub '(complex complex) (lambda (z1 z2) (typetag (sub-complex z1 z2)))) (put 'mul '(complex complex) diff --git a/coding-exercises/2/83/install-rational.rkt b/coding-exercises/2/83/install-rational.rkt index 73640b7..337f38b 100644 --- a/coding-exercises/2/83/install-rational.rkt +++ b/coding-exercises/2/83/install-rational.rkt @@ -11,6 +11,9 @@ (make-rat (+ (* (numer x) (denom y)) (* (numer y) (denom x))) (* (denom x) (denom y)))) + (define (neg-rat rat) + (make-rat (- (numer rat)) + (denom rat))) (define (sub-rat x y) (make-rat (- (* (numer x) (denom y)) (* (numer y) (denom x))) diff --git a/coding-exercises/2/83/install-real.rkt b/coding-exercises/2/83/install-real.rkt index 68f5e31..6b96137 100644 --- a/coding-exercises/2/83/install-real.rkt +++ b/coding-exercises/2/83/install-real.rkt @@ -14,6 +14,7 @@ (put 'make 'real (lambda (x) (tagme (make x)))) ;; methods (put 'add '(real real) (lambda (x y) (tagme (make (+ x y))))) + (put 'neg '(real) (lambda (x) (tagme (make (- x))))) (put 'sub '(real real) (lambda (x y) (tagme (make (- x y))))) (put 'mul '(real real) (lambda (x y) (tagme (make (* x y))))) (put 'div '(real real) (lambda (x y) (tagme (make (/ x y))))) diff --git a/coding-exercises/2/83/install.rkt b/coding-exercises/2/83/install.rkt index 0cd8bbf..d972784 100644 --- a/coding-exercises/2/83/install.rkt +++ b/coding-exercises/2/83/install.rkt @@ -86,6 +86,8 @@ (apply-fn '=zero? datum)) (define (add a1 a2) (apply-fn 'add a1 a2)) +(define (neg a) + (apply-fn 'neg a)) (define (sub a1 a2) (apply-fn 'sub a1 a2)) (define (mul a1 a2) diff --git a/coding-exercises/2/87.rkt b/coding-exercises/2/87.rkt index f368ed4..a8b1ed0 100644 --- a/coding-exercises/2/87.rkt +++ b/coding-exercises/2/87.rkt @@ -7,7 +7,78 @@ (define put (cadr get-put-apply)) (define apply-fn (caddr get-put-apply)) -(define (install-polynomial-package put) +(define (install-term-package put) + (define (tagme term) + (attach-tag 'term term)) + (put 'make-from-order-coeff 'term (lambda (order coeff) (tagme (list order coeff)))) + (put 'order '(term) (lambda (term) (car term))) + (put 'coeff '(term) (lambda (term) (cadr term)))) + +(define (install-sparse-termlist-package put) + ;; methods imported from term package + (define (order term) + ((get 'order '(term)) term)) + (define (coeff term) + ((get 'coeff '(term)) term)) + (define (make-term order coeff) + ((get 'make-from-order-coeff 'term) order coeff)) + + ;; selectors + ;; export first term as typed term + (define (first-term term-list) + (let ((term (car term-list))) + (make-term (car term) + (cdr term)))) + (define (rest-terms term-list) (cdr term-list)) + + ;; ops + ;; map neg over internal storage type (order coeff) + (define (neg termlist) + (map (lambda (term) + (cons + (car term) + (apply-fn 'neg (cdr term)))) + termlist)) + + ;; convert term contents to our format + (define (term-contents->order-coeff-pair term) + (cons (order term) + (coeff term))) + (define (adjoin-term term term-list) + (if (=zero? (coeff term)) + term-list + (cons (term-contents->order-coeff-pair term) + term-list))) + + ;; preds + (define (the-empty-termlist) '()) + (define (empty-termlist? term-list) (null? term-list)) + + ;; constructors + ;; store as ((order coeff)), list of untyped (order coeff) pairs + (define (term->order-coeff-pair term) + (cons (apply-fn 'order term) + (apply-fn 'coeff term))) + (define (make-from-terms terms) + (map term->order-coeff-pair terms)) + + + ;; interface methods + (define (tagme datum) + (attach-tag 'sparse-termlist datum)) + ;; constructors + (put 'make-from-terms 'sparse-termlist (lambda (t) (tagme (make-from-terms t)))) + ;; ops + (put 'neg '(sparse-termlist) (lambda (termlist) (tagme (neg termlist)))) + (put 'adjoin-term '(term sparse-termlist) (lambda (term termlist) (tagme (adjoin-term term termlist)))) + (put 'rest-terms '(sparse-termlist) (lambda (termlist) (tagme (rest-terms termlist)))) + ;; term selector + (put 'first-term '(sparse-termlist) first-term) + ;; pred + (put 'empty-termlist? '(sparse-termlist) empty-termlist?) + (put 'the-empty-termlist 'sparse-termlist (lambda () (tagme (the-empty-termlist))))) + +(define (install-polynomial-package put get) ;; internal procedures (define (tagme p) (attach-tag 'polynomial p)) @@ -15,23 +86,37 @@ (define (same-variable? x y) (and (variable? x) (variable? y) (eq? x y))) ;; terms - (define (make-term order coeff) (list order coeff)) - (define (order term) (car term)) - (define (coeff term) (cadr term)) + (install-term-package put) + (define (make-term order coeff) + ((get 'make-from-order-coeff 'term) order coeff)) + (define (order term) + (apply-fn 'order term)) + (define (coeff term) + (apply-fn 'coeff term)) ;; termlists - (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)) + (install-sparse-termlist-package put) + (define (make-term-list terms) + ((get 'make-from-terms 'sparse-termlist) terms)) + (define (empty-termlist? termlist) + (apply-fn 'empty-termlist? termlist)) + (define (the-empty-termlist termlist) + ((get 'the-empty-termlist (type-tag termlist)))) + (define (first-term termlist) + (apply-fn 'first-term termlist)) + (define (adjoin-term term termlist) + (apply-fn 'adjoin-term term termlist)) + (define (rest-terms termlist) + (apply-fn 'rest-terms termlist)) ;; polys + (define (ensure-termlist termlist) + (if (or + (equal? 'sparse-termlist (type-tag termlist))) + termlist + (error "Unsupported type-tag for termlist --" termlist))) (define (make-poly variable term-list) - (cons variable term-list)) + (cons variable (ensure-termlist term-list))) (define (variable p) (car p)) (define (term-list p) (cdr p)) @@ -67,17 +152,13 @@ (define (neg-poly poly) (make-poly (variable poly) - (map (lambda (term) - (make-term - (order term) - (apply-fn 'neg (coeff term)))) - (term-list poly)))) + (apply-fn 'neg (term-list poly)))) (define (sub-poly p1 p2) (add-poly p1 (neg-poly p2))) (define (mul-term-by-all-terms t1 L) (if (empty-termlist? L) - (the-empty-termlist) + (the-empty-termlist L) (let ((t2 (first-term L))) (adjoin-term (make-term (+ (order t1) (order t2)) @@ -85,7 +166,7 @@ (mul-term-by-all-terms t1 (rest-terms L)))))) (define (mul-terms L1 L2) (if (empty-termlist? L1) - (the-empty-termlist) + (the-empty-termlist L1) (add-terms (mul-term-by-all-terms (first-term L1) L2) (mul-terms (rest-terms L1) L2)))) (define (mul-poly p1 p2) @@ -105,25 +186,30 @@ ;;interface (put 'add '(polynomial polynomial) (lambda (p1 p2) (tagme (add-poly p1 p2)))) (put 'neg '(polynomial) (lambda (p) (tagme (neg-poly p)))) - (put 'sub '(polynomial polynomial) (lambda (p1 p2) (tagme (sub-poly p1 p2)))) + (put 'sub '(polynomial polynomial) (lambda (p1 p2) + (tagme (sub-poly p1 p2)))) (put 'mul '(polynomial polynomial) (lambda (p1 p2) (tagme (mul-poly p1 p2)))) (put 'make 'polynomial (lambda (var terms) (tagme (make-poly var terms)))) 'done) -(install-polynomial-package put) +(install-polynomial-package put get) +(define (term order coeff) + ((get 'make-from-order-coeff 'term) order coeff)) +(define (sparse-termlist . terms) + ((get 'make-from-terms 'sparse-termlist) terms)) (define (make-polynomial var terms) ((get 'make 'polynomial) var terms)) -(define test-poly1 (make-polynomial 'x (list - (list 1 test-integer)))) -(define test-poly2 (make-polynomial 'x (list - (list 100 test-complex) - (list 3 test-real) - (list 1 test-rat) - (list 0 test-integer)))) -(define test-poly3 (make-polynomial 'x (list - (list 1 2) - (list 0 2)))) +(define test-poly1 (make-polynomial 'x (sparse-termlist + (term 1 test-integer)))) +(define test-poly2 (make-polynomial 'x (sparse-termlist + (term 100 test-complex) + (term 3 test-real) + (term 1 test-rat) + (term 0 test-integer)))) +(define test-poly3 (make-polynomial 'x (sparse-termlist + (term 1 2) + (term 0 2)))) ((lambda () (newline) (display (add test-poly2 test-poly2)) @@ -134,7 +220,8 @@ ;;87 (=zero? test-poly3) -(=zero? (make-polynomial 'x (list (list 1000 0)))) +(=zero? (make-polynomial 'x (sparse-termlist + (term 1000 0)))) ;; 88 ;; what is meant with negation here? Negation of a number? Making a negative number? @@ -144,3 +231,6 @@ (display (sub test-poly1 test-poly3)) (newline) (display (sub test-poly1 test-poly2)))) + +;; 89 +;; Dense polys are just lists where the length of the sublist until the term is the order of the term |