sicp_2_5_3.rkt

;; 2.5.3  Example: Symbolic Algebra

(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)))

(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 (op-terms op 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 (op-terms op (rest-terms L1) L2)))
                 ((< (order t1) (order t2))
                  (adjoin-term 
                   t2 (op-terms op L1 (rest-terms L2))))
                 (else
                  (adjoin-term
                   (make-term (order t1)
                              (op (coeff t1) (coeff t2)))
                   (op-terms op (rest-terms L1)
                             (rest-terms L2)))))))))

(define (add-terms L1 L2)
  (op-terms add L1 L2))

(define (mul-terms L1 L2)
  (if (empty-termlist? L1)
      (the-empty-termlist)
      (let ((fst (mul-term-by-all-terms (first-term L1) L2) )
            (rst (mul-terms (rest-terms L1) L2)))
        (add-terms fst rst))))

(define (mul-term-by-all-terms t1 L)
  (if (empty-termlist? L)
      (the-empty-termlist)
      (let* ((t2 (first-term L))
             (term (make-term (+ (order t1) (order t2))
                              (mul (coeff t1) (coeff t2))))
             (restTerms (mul-term-by-all-terms t1 (rest-terms L))))
        (adjoin-term term restTerms))))

(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 (install-polynomial-package)
  ;; internal procedures
  ;; representation of poly
  
  ;; interface to rest of the system
  (define (tag p) (attach-tag 'polynomial p))
  (put 'add '(polynomial polynomial) 
       (lambda (p1 p2) (tag (add-poly p1 p2))))
  (put 'mul '(polynomial polynomial) 
       (lambda (p1 p2) (tag (mul-poly p1 p2))))
  (put 'make 'polynomial
       (lambda (var terms) (tag (make-poly var terms))))
  'done)

(install-polynomial-package)

(define (make-polynomial var terms)
  ((get 'make 'polynomial) var terms))

(define z2+3i (make-complex-from-real-imag 2 3))
(define z5+3i (make-complex-from-real-imag 5 3))
(define r2/3 (make-rational 2 3))

(define (map-indexed f xs)
  (if (null? xs) '()
      (let ((nxt (map-indexed f (cdr xs))))
        (if (=zero? (car xs)) nxt
            (cons (f (length xs) (car xs))
                  nxt)))))
(define make-sparse-term-list
  (curry map-indexed (lambda (i x) (make-term i x))))

(define p1 (make-polynomial
            'x (make-sparse-term-list (list 3 z2+3i 7))))
;; (polynomial x (3 3) (2 (complex rectangular 2 . 3)) (1 7))
(define p2 (make-polynomial
            'x (make-sparse-term-list (list 1 0 r2/3  z5+3i))))
;; (polynomial x (4 1) (2 (rational 2 . 3)) (1 (complex rectangular 5 . 3)))


(equal?
 (add p1 p2)

 '(polynomial
   x (4 1) (3 3)
   (2 (complex rectangular
               (scheme-number . 2.6666666666666665)
               scheme-number . 3))
   (1 (complex rectangular
               (scheme-number . 12) scheme-number . 3))))

(equal?
 (mul p1 p2)
 
 '(polynomial
  x (7 (scheme-number . 3))
  (6 (complex  polar (scheme-number . 3.605551275463989)
               rational 8852218891597467 . 9007199254740992))
  (5 (integer . 9))
  (4 (complex rectangular
              (rational 2298712309803691.0 . 140737488355328.0)
              rational 6192449487634433.0 . 562949953421312.0))
  (3 (complex rectangular
              (rational 6380099472108203.0 . 1125899906842624.0)
              rational 5910974510923777.0 . 281474976710656.0))
  (2 (complex polar
              (scheme-number . 40.81666326391711)
              rational 4867666120084705 . 9007199254740992))))

(define p22 (make-polynomial 'x (make-sparse-term-list '(2 2))))

;; Exercise 2.87

(put '=zero? '(polynomial) (compose null? cdr))

(define p3 (make-polynomial
            'x (make-sparse-term-list
                (list
                 (make-polynomial 'y '((2 1) (1 1)))
                 (make-polynomial 'y '((3 1) (1 1)))
                 (make-polynomial 'y '((2 1) (1 -1)))))))

(define p4 (make-polynomial
            'x (make-sparse-term-list
                (list
                 (make-polynomial 'y '((2 1) (1 -2)))
                 (make-polynomial 'y '((3 1) (1 7)))))))

(equal?
 (add p3 p4)

 '(polynomial
  x
  (3 (polynomial y (2 1) (1 1)))
  (2 (polynomial y (3 1) (2 1) (1 (scheme-number . -1))))
  (1 (polynomial y (3 1) (2 1) (1 (scheme-number . 6))))))

(equal?
 (mul p3 p4)
 
 '(polynomial
   x (5 (polynomial
         y (4 (scheme-number . 1))
                (3 (scheme-number . -1))
                (2 (scheme-number . -2))))
   (4 (polynomial
       y (5 (scheme-number . 2))
       (4 (scheme-number . -1))
       (3 (scheme-number . 8))
       (2 (scheme-number . 5))))
   (3 (polynomial
       y (6 (scheme-number . 1))
       (4 (scheme-number . 9))
       (3 (scheme-number . -3))
       (2 (scheme-number . 9))))
   (2 (polynomial
       y (5 (scheme-number . 1))
              (4 (scheme-number . -1))
              (3 (scheme-number . 7))
              (2 (scheme-number . -7))))))

;;Exercise 2.88.

(define (sub-poly p1 p2)
  (if (same-variable? (variable p1) (variable p2))
      (make-poly (variable p1)
                 (sub-terms (term-list p1)
                            (term-list p2)))
      (error "Polys not in same var -- ADD-POLY"
             (list p1 p2))))

(define (sub-terms L1 L2)
  (op-terms sub  L1 L2))

(put 'sub '(polynomial polynomial) 
     (lambda (p1 p2) (attach-tag 'polynomial (sub-poly p1 p2))))

(equal?
 (sub p1 p2)
 '(polynomial
   x (4 1) (3 3)
   (2 (complex rectangular
               (scheme-number . 1.3333333333333335)
                scheme-number . 3))
   (1 (complex rectangular (scheme-number . 2) scheme-number . -3))))

;; Exercise 2.89. and 2.90

(define (install-term-package)
  (put 'order '(term) car)
  (put 'coeff '(term) cadr)
  'done)

(install-term-package)

(define order (curry apply-generic 'order))
(define coeff (curry apply-generic 'coeff))
(define (make-term order coeff)
  (attach-tag 'term (list order coeff)))

(define (install-sparse-term-list-package)
  (define tag (curry attach-tag 'sparse))
  (define make-sparse-term-list
    (curry map-indexed
           (lambda (i x)
             (make-term i x))))
  (define  (make-term-list xs)
    (tag (make-sparse-term-list xs)))
  (define (adjoin-term term term-list)
    (let ((t (attach-tag 'term term)))
      (tag (if (=zero? (coeff t))
               term-list
               (cons t term-list)))))
  (put 'make-term-list '(sparse) make-term-list)
  (put 'adjoin-term '(term sparse) adjoin-term)
  (put 'first-term '(sparse) car)
  (put 'rest-terms '(sparse) (compose tag cdr))
  (put 'empty-termlist? '(sparse) null?)
  'done)

(install-sparse-term-list-package)

(define (install-dense-term-list-package)
  (define tag (curry attach-tag 'dense))
  (define (make-term-list xs) (tag xs))
  (define (adjoin-term term lst) 
    (let ((t (attach-tag 'term term)))
      (tag (cons (coeff t) lst))))
  (define (first-term term-list)
    (make-term (length term-list)
               (car term-list)))
  (put 'make-term-list '(dense) make-term-list)
  (put 'adjoin-term '(term dense) adjoin-term)
  (put 'first-term '(dense) first-term)
  (put 'rest-terms '(dense) (compose tag cdr))
  (put 'empty-termlist? '(dense) null?)
  'done)

(install-dense-term-list-package)

(define make-term-list 
  (curry apply-generic 'make-term-list))
(define adjoin-term
  (curry apply-generic 'adjoin-term))
(define first-term
  (curry apply-generic 'first-term))
(define rest-terms
  (curry apply-generic 'rest-terms))
(define empty-termlist?
  (curry apply-generic 'empty-termlist?))

(define (make-dense-term-list term-list)
  (make-term-list (attach-tag 'dense term-list)))
(define (make-sparse-term-list term-list)
  (make-term-list (attach-tag 'sparse term-list)))

(define p1 (make-polynomial
            'x (make-sparse-term-list (list 3 z2+3i 7))))
(define p2 (make-polynomial
            'x (make-sparse-term-list (list 1 0 r2/3  z5+3i))))

(equal?
 (add p1 p2)
 '(polynomial
   x sparse
   (term 4 1) (term 3 3)
   (term 2 (complex rectangular
                    (scheme-number . 2.6666666666666665)
                    scheme-number . 3))
   (term 1 (complex rectangular
                    (scheme-number . 12) scheme-number . 3))))

(define default-term-list-type 'sparse)
(define (the-empty-termlist)
  (attach-tag default-term-list-type '()))

(mul p1 p2)

(define p3d (make-polynomial
             'x  (make-dense-term-list '(2 2))))
(define p1d (make-polynomial
             'x (make-dense-term-list
                 (list 3 z2+3i 7))))
(define p2d (make-polynomial
             'x (make-dense-term-list
                 (list 1 0 r2/3  z5+3i))))

(add p1d p2d)
(mul p1d p2d)
(add p1 p2d)
(add p1d p2)
(mul p1d p2)
(mul p1 p2d)