Smatchcube's website 🌍


Exercise 2.90

This exercise is really difficult in my opinion if we want to have the possibility to use operations on two polynomials with different representations like we did for complex numbers. The problem is that polynomials are much more complex data structures so to simplify the task I only allow the possibility to use operations only on polynomials using the same representation. I might try to think about this feature later if I have time.\ Here is the whole code, sadly as I stated above many lines must be duplicated.

(define (install-polynomial-package)
  (define (make-dense-polynomial var terms)
    ((get 'make-dense-polynomial 'dense) var terms))
  (define (make-sparse-polynomial var terms)
    ((get 'make-sparse-polynomial 'sparse) var terms))
  (define (tag p) (attach-tag 'polynomial p))
  (put 'make-dense-polynomial 'polynomial
       (lambda (var terms) (tag (make-dense-polynomial var terms))))
  (put 'make-sparse-polynomial 'polynomial
       (lambda (var terms) (tag (make-sparse-polynomial var terms))))
  (put 'add '(polynomial polynomial)
       (lambda (p1 p2) (tag (add p1 p2))))
  (put 'sub '(polynomial polynomial)
       (lambda (p1 p2) (tag (sub p1 p2))))
  (put 'mul '(polynomial polynomial)
       (lambda (p1 p2) (tag (mul p1 p2))))
  (put 'neg '(polynomial)
       (lambda (p) (tag (neg p))))
  (put '=zero? '(polynomial)
       (lambda (p) (=zero? p)))
  'done)
(define (make-dense-polynomial var terms)
  ((get 'make-dense-polynomial 'polynomial) var terms))
(define (make-sparse-polynomial var terms)
  ((get 'make-sparse-polynomial 'polynomial) var terms))
(install-polynomial-package)


(define (install-dense-polynomial-package)
  ;; internal procedures
  (define (add-terms L1 L2)
    (cond ((empty-termlist? L1) L2)
          ((empty-termlist? L2) L1)
          (else
           (let ((t1 (first-term L1))
                 (t2 (first-term L2)))
             (cond ((> (order t1) (order t2))
                    (adjoin-term
                     t1 (add-terms (rest-terms L1) L2)))
                   ((< (order t1) (order t2))
                    (adjoin-term
                     t2 (add-terms L1 (rest-terms L2))))
                   (else
                    (adjoin-term
                     (make-term (order t1)
                                (add (coeff t1) (coeff t2)))
                     (add-terms (rest-terms L1)
                                (rest-terms L2)))))))))
  (define (neg-terms L)
    (if (empty-termlist? L)
        (the-empty-termlist)
        (adjoin-term (make-term (order (first-term L))
                                (neg (coeff (first-term L))))
                     (neg-terms (rest-terms L)))))
  (define (mul-terms L1 L2)
    (if (empty-termlist? L1)
        (the-empty-termlist)
        (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)
        (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))))))
  (define (sub-terms L1 L2)
    (add-terms L1 (neg-terms L2)))
  ;; 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 (variable? x) (symbol? x))
  (define (same-variable? v1 v2)
    (and (variable? v1) (variable? v2) (eq? v1 v2)))
  ;; representation of terms and terms lists
  (define (adjoin-term term term-list)
    (cond ((=zero? (coeff term)) term-list)
          ((empty-termlist? term-list)
           (if (=zero? (order term))
               (list (coeff term))
               (adjoin-term term '(0))))
          ((equ? (order term) (add (order (first-term term-list)) 1))
           (cons (coeff term) term-list))
          (else (adjoin-term term (cons 0 term-list)))))
  (define (the-empty-termlist) '())
  (define (first-term term-list)
    (list (length (cdr term-list)) (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))
  (define (add-poly p1 p2)
    (if (same-variable? (variable p1) (variable p2))
        (make-poly (variable p1)
                   (add-terms (term-list p1)
                              (term-list p2)))
        (error "Polys not in same var: ADD-POLY"
               (list p1 p2))))
  (define (mul-poly p1 p2)
    (if (same-variable? (variable p1) (variable p2))
        (make-poly (variable p1)
                   (mul-terms (term-list p1)
                              (term-list p2)))
        (error "Polys not in same var: MUL-POLY"
               (list p1 p2))))
  (define (=zero-poly? poly)
    (cond ((empty-termlist? (term-list poly)) true)
          ((=zero? (coeff (first-term (term-list poly))))
           (=zero-poly? (make-poly (variable poly)
                                   (rest-terms (term-list poly)))))
          (else false)))
  (define (neg-poly p)
    (make-poly (variable p) (neg-terms (term-list p))))
  (define (sub-poly p1 p2)
    (if (same-variable? (variable p1) (variable p2))
        (add-poly p1 (neg-poly p2))
        (error "Polys not in same var: SUB-POLY"
               (list p1 p2))))
  ;; interface to the rest of the system
  (define (tag p) (attach-tag 'dense p))
  (put 'add '(dense dense)
        (lambda (p1 p2) (tag (add-poly p1 p2))))
  (put 'mul '(dense dense)
        (lambda (p1 p2) (tag (mul-poly p1 p2))))
  (put 'make-dense-polynomial 'dense
        (lambda (var terms)
          (tag (make-poly var terms))))
  (put '=zero? '(dense)
       (lambda (poly) (=zero-poly? poly)))
  (put 'neg '(dense)
       (lambda (poly) (tag (neg-poly poly))))
  (put 'sub '(dense dense)
       (lambda (p1 p2) (tag (sub-poly p1 p2))))
  'done)
(install-dense-polynomial-package)


(define (install-sparse-polynomial-package)
  ;; internal procedures
  (define (add-terms L1 L2)
    (cond ((empty-termlist? L1) L2)
          ((empty-termlist? L2) L1)
          (else
           (let ((t1 (first-term L1))
                 (t2 (first-term L2)))
             (cond ((> (order t1) (order t2))
                    (adjoin-term
                     t1 (add-terms (rest-terms L1) L2)))
                   ((< (order t1) (order t2))
                    (adjoin-term
                     t2 (add-terms L1 (rest-terms L2))))
                   (else
                    (adjoin-term
                     (make-term (order t1)
                                (add (coeff t1) (coeff t2)))
                     (add-terms (rest-terms L1)
                                (rest-terms L2)))))))))
  (define (neg-terms L)
    (if (empty-termlist? L)
        (the-empty-termlist)
        (adjoin-term (make-term (order (first-term L))
                                (neg (coeff (first-term L))))
                     (neg-terms (rest-terms L)))))
  (define (mul-terms L1 L2)
    (if (empty-termlist? L1)
        (the-empty-termlist)
        (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)
        (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))))))
  ;; 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 (variable? x) (symbol? x))
  (define (same-variable? v1 v2)
    (and (variable? v1) (variable? v2) (eq? v1 v2)))
  ;; representation of terms and terms lists
  (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))
  (define (make-term order coeff) (list order coeff))
  (define (order term) (car term))
  (define (coeff term) (cadr term))
  (define (add-poly p1 p2)
    (if (same-variable? (variable p1) (variable p2))
        (make-poly (variable p1)
                   (add-terms (term-list p1)
                              (term-list p2)))
        (error "Polys not in same var: ADD-POLY"
               (list p1 p2))))
  (define (mul-poly p1 p2)
    (if (same-variable? (variable p1) (variable p2))
        (make-poly (variable p1)
                   (mul-terms (term-list p1)
                              (term-list p2)))
        (error "Polys not in same var: MUL-POLY"
               (list p1 p2))))
  (define (=zero-poly? poly)
    (cond ((empty-termlist? (term-list poly)) true)
          ((=zero? (coeff (first-term (term-list poly))))
           (=zero-poly? (make-poly (variable poly)
                                   (rest-terms (term-list poly)))))
          (else false)))
  (define (neg-poly p)
    (make-poly (variable p) (neg-terms (term-list p))))
  (define (sub-poly p1 p2)
    (if (same-variable? (variable p1) (variable p2))
        (add-poly p1 (neg-poly p2))
        (error "Polys not in same var: SUB-POLY"
               (list p1 p2))))
  ;; interface to the rest of the system
  (define (tag p) (attach-tag 'sparse p))
  (put 'add '(sparse sparse)
        (lambda (p1 p2) (tag (add-poly p1 p2))))
  (put 'mul '(sparse sparse)
        (lambda (p1 p2) (tag (mul-poly p1 p2))))
  (put 'make-sparse-polynomial 'sparse
        (lambda (var terms)
          (tag (make-poly var terms))))
  (put '=zero? '(sparse)
       (lambda (poly) (=zero-poly? poly)))
  (put 'neg '(sparse)
       (lambda (poly) (tag (neg-poly poly))))
  (put 'sub '(sparse sparse)
       (lambda (p1 p2) (tag (sub-poly p1 p2))))
  'done)
(install-sparse-polynomial-package)