# sarabander/p2pu-sicp

symbolic algebra

1 parent 5762299 commit 94d6cd2ae031ac0c69ab1f791931d0a3af366f8f committed Oct 14, 2011
Showing with 293 additions and 0 deletions.
1. +52 −0 2.5/2.87.scm
2. +30 −0 2.5/2.88.scm
3. +4 −0 2.5/2.89.scm
4. +4 −0 2.5/2.90.scm
5. +203 −0 2.5/2.91.scm
 @@ -0,0 +1,52 @@ + +;; Let our polynomial be structured as: +;; +;; '(polynomial .. ) +;; +;; where is the indeterminate, like 'x or 'y, +;; .. are terms: +;; coeff[n] coeff[n-1] .. coeff[0] when dense, +;; (order coeff) (order coeff) .. when sparse. + +;; Example polynomials: +(define poly1 '(polynomial x 5 -2 0 4 2)) +(define poly2 '(polynomial y (4 5) (3 -2) (1 4) (0 2))) +(define poly3 '(polynomial y)) +(define poly4 '(polynomial x 0 0 0)) + +(define (list-of-zeros? lst) + (eval (cons 'and + (map (λ (elem) + (and (number? elem) + (zero? elem))) + lst)))) + +;; '=zero?' is installed to polynomial package in the file +;; generic-arithmetic/polynomials.scm: +(put '=zero? '(polynomial) + (λ (p) (list-of-zeros? (contents p)))) + +;; Tests +(list-of-zeros? '()) ; true +(list-of-zeros? '(3 -3 0)) ; false +(list-of-zeros? '(a b c)) ; false +(list-of-zeros? '(0 0 0)) ; true + +(=zero? poly1) ; false +(=zero? poly2) ; false +(=zero? poly3) ; true +(=zero? poly4) ; true + +;; Addition and multiplication tests + +(add poly3 poly3) ; '(polynomial y) +(add poly2 poly2) ; '(polynomial y (4 10) (3 -4) (1 8) (0 4)) +(add poly4 poly4) ; '(polynomial x 0 0 0) +(add poly1 poly4) ; '(polynomial x 5 -2 0 4 2) +(add poly1 poly1) ; '(polynomial x 10 -4 0 8 4) + +(mul poly1 poly4) ; '(polynomial x) +(mul poly1 poly1) +; '(polynomial x (8 25) (7 -20) (6 4) (5 40) (4 4) (3 -8) (2 16) (1 16) (0 4)) +(mul poly2 poly2) +; '(polynomial y (8 25) (7 -20) (6 4) (5 40) (4 4) (3 -8) (2 16) (1 16) (0 4))
 @@ -0,0 +1,30 @@ + +;; Negation and subtraction are added to generic-arithmetic/polynomials.scm: + +;; Negates all terms +(define (negate-termlist termlist) + (if (empty? termlist) + empty + (let ((negator (if (list? (car termlist)) + (λ (elem) (list (car elem) (- (cadr elem)))) + -))) + (map negator termlist)))) + +(put 'neg '(polynomial) + (lambda (p) + (tag (cons (variable p) + (negate-termlist (contents p)))))) + +(put 'sub '(polynomial polynomial) + (lambda (p1 p2) (tag (add-poly p1 (contents (neg (tag p2))))))) + +;; Tests +(neg poly1) ; '(polynomial x -5 2 0 -4 -2) +(neg poly2) ; '(polynomial y (4 -5) (3 2) (1 -4) (0 -2)) +(neg poly3) ; remains the same +(neg poly4) ; remains the same + +(sub poly1 poly1) ; '(polynomial x 0 0 0 0 0) +(sub poly2 poly2) ; '(polynomial y) +(sub poly3 poly2) ; '(polynomial y (4 -5) (3 2) (1 -4) (0 -2)) +(sub poly4 poly1) ; '(polynomial x -5 2 0 -4 -2)
 @@ -0,0 +1,4 @@ + +;; The definitions in polynomial package are modified to recognize dense +;; polynomials. The termlist handling procedures are aware of dense +;; and sparse format. See generic-arithmetic/polynomials.scm.
 @@ -0,0 +1,4 @@ + +;; The definitions in polynomial package are modified to recognize dense +;; polynomials. The termlist handling procedures are aware of dense +;; and sparse format. See generic-arithmetic/polynomials.scm.