diff options
Diffstat (limited to 'coding-exercises/2/83')
| -rw-r--r-- | coding-exercises/2/83/install-integer.rkt | 6 | ||||
| -rw-r--r-- | coding-exercises/2/83/install-rational.rkt | 2 | ||||
| -rw-r--r-- | coding-exercises/2/83/install-real.rkt | 19 | ||||
| -rw-r--r-- | coding-exercises/2/83/polynomials.rkt | 29 |
4 files changed, 39 insertions, 17 deletions
diff --git a/coding-exercises/2/83/install-integer.rkt b/coding-exercises/2/83/install-integer.rkt index d2f34fb..6972b71 100644 --- a/coding-exercises/2/83/install-integer.rkt +++ b/coding-exercises/2/83/install-integer.rkt @@ -27,6 +27,11 @@ a (gcd-integer b (remainder a b)))) + (define (reduce-integers n d) + (let ((g (gcd-integer n d))) + (list (/ n g) + (/ d g)))) + ;; methods (put 'add '(integer integer) (lambda (x y) (+ x y))) (put 'neg '(integer) (lambda (x) (- x))) @@ -35,6 +40,7 @@ (put 'div '(integer integer) (lambda (x y) (/ x y))) (put 'greatest-common-divisor '(integer integer) gcd-integer) (put 'raise '(integer) raiseme) + (put 'reduce '(integer integer) reduce-integers) ;; sqrt and trig methods for complex nums (put 'expt '(integer integer) expt) (put 'sqr '(integer) sqr) diff --git a/coding-exercises/2/83/install-rational.rkt b/coding-exercises/2/83/install-rational.rkt index 9481101..1a8f1ef 100644 --- a/coding-exercises/2/83/install-rational.rkt +++ b/coding-exercises/2/83/install-rational.rkt @@ -38,7 +38,7 @@ (let ((proc (get 'greatest-common-divisor (list (type-tag a) (type-tag b))))) (if proc (proc (contents a) (contents b)) - (error "Not implemented -- " (list 'greatest-common-divisor (type-tag a) (type-tag b)))))) + (error "Not implemented -- " (list 'greatest-common-divisor a (type-tag a) b (type-tag b)))))) ;; constructor and selectors diff --git a/coding-exercises/2/83/install-real.rkt b/coding-exercises/2/83/install-real.rkt index 2141059..2089437 100644 --- a/coding-exercises/2/83/install-real.rkt +++ b/coding-exercises/2/83/install-real.rkt @@ -19,12 +19,18 @@ ;; methods (define (gcd-real a b) - (if (and (integer? a) - (integer? b)) - (if (= b 0) - a - (gcd-real b (remainder a b))) - a)) + (cond ((and (integer? a) + (integer? b)) + (if (= b 0) + a + (gcd-real b (remainder a b)))) + ((= b 1) a) + (else (error "gcd for reals not implemented")))) + + (define (reduce-integers n d) + (let ((g (gcd-real n d))) + (list (/ n g) + (/ d g)))) (put 'add '(real real) (lambda (x y) (tagme (make (+ x y))))) (put 'neg '(real) (lambda (x) (tagme (make (- x))))) @@ -36,6 +42,7 @@ ((get 'make 'rational) n 1.0))) (put 'greatest-common-divisor '(real real) (lambda (a b) (tagme (gcd-real a b)))) ;; expt for integerizing factor + (put 'reduce '(real real) (lambda (n d) (reduce-integers n d))) (put 'expt '(real real) expt) ;; sqrt and trig methods for complex nums (put 'sqr '(real) sqr) diff --git a/coding-exercises/2/83/polynomials.rkt b/coding-exercises/2/83/polynomials.rkt index 37231fd..7698c39 100644 --- a/coding-exercises/2/83/polynomials.rkt +++ b/coding-exercises/2/83/polynomials.rkt @@ -396,7 +396,7 @@ ;; TODO(mike): this should take a list of term list and compute the gcd of all the coefficients of the termlist - (define (remove-common-factors . a) + (define (remove-common-factors a) (let ((g (apply-fn 'gcd a))) (newline) (newline) @@ -422,6 +422,12 @@ (remove-common-factors a) (gcd-terms b (pseudoremainder-terms a b)))) + (define (join-terms a b) + (if (empty-termlist? a) + b + (join-terms (rest-terms a) + (adjoin-term (first-term a) b)))) + (define (reduce-terms n d) (let ((g (gcd-terms n d)) (O1 (max (coeff (first-term n)) @@ -432,23 +438,26 @@ (let ((c (apply-fn 'expt (coeff (first-term g)) (+ 1 O1 (- (order (first-term g))))))) - (let ((nn (remove-common-factors (get-if-divided (div-terms - (mul-terms n (make-term-list (list (make-term 0 c)))) - g)))) - (dd (remove-common-factors (get-if-divided (div-terms - (mul-terms d (make-term-list (list (make-term 0 c)))) - g))))) - (list nn dd))))) + (let ((nn (get-if-divided (div-terms + (mul-terms n (make-term-list (list (make-term 0 c)))) + g))) + (dd (get-if-divided (div-terms + (mul-terms d (make-term-list (list (make-term 0 c)))) + g)))) + (let ((common-denom-nn-dd (apply-fn 'gcd (join-terms nn dd)))) + (let ((divisor (make-term-list (list (make-term 0 common-denom-nn-dd))))) + (list (div-terms nn divisor) + (div-terms dd divisor)))))))) (define (reduce-poly p1 p2) (if (same-variable? (variable p1) (variable p2)) (let ((reduced-polies (reduce-terms (term-list p1) (term-list p2)))) (list (make-poly (variable p1) - (car reduced-polies)) + (get-if-divided (car reduced-polies))) (make-poly (variable p1) - (cadr reduced-polies)))) + (get-if-divided (cadr reduced-polies))))) (error "Polys not in same var -- ADD-POLY" (list p1 p2)))) (define (gcd-poly p1 p2) |