diff options
Diffstat (limited to 'coding-exercises')
| -rw-r--r-- | coding-exercises/2/83/install-integer.rkt | 6 | ||||
| -rw-r--r-- | coding-exercises/2/83/install-rational.rkt | 6 | ||||
| -rw-r--r-- | coding-exercises/2/83/install-real.rkt | 2 | ||||
| -rw-r--r-- | coding-exercises/2/83/polynomials.rkt | 100 | ||||
| -rw-r--r-- | coding-exercises/2/93.rkt | 24 |
5 files changed, 127 insertions, 11 deletions
diff --git a/coding-exercises/2/83/install-integer.rkt b/coding-exercises/2/83/install-integer.rkt index ca33ba0..d2f34fb 100644 --- a/coding-exercises/2/83/install-integer.rkt +++ b/coding-exercises/2/83/install-integer.rkt @@ -21,6 +21,8 @@ (define (gcd-integer a b) (newline) (display (list "GCD-INTEGER -- " a b)) + (newline) + (newline) (if (= b 0) a (gcd-integer b (remainder a b)))) @@ -31,10 +33,10 @@ (put 'sub '(integer integer) (lambda (x y) (- x y))) (put 'mul '(integer integer) (lambda (x y) (* x y))) (put 'div '(integer integer) (lambda (x y) (/ x y))) - (put 'greatest-common-divisor '(integer integer) (lambda (a b) - (gcd-integer a b))) + (put 'greatest-common-divisor '(integer integer) gcd-integer) (put 'raise '(integer) raiseme) ;; sqrt and trig methods for complex nums + (put 'expt '(integer integer) expt) (put 'sqr '(integer) sqr) (put 'sqrt '(integer) sqrt) (put 'atan '(integer integer) atan) diff --git a/coding-exercises/2/83/install-rational.rkt b/coding-exercises/2/83/install-rational.rkt index 127871a..9481101 100644 --- a/coding-exercises/2/83/install-rational.rkt +++ b/coding-exercises/2/83/install-rational.rkt @@ -97,8 +97,8 @@ ((get 'make 'integer) (/ (numer rat) (denom rat))) (list 'undefined))) (define (raiseme rat) - (if (and (integer? (numer rat)) - (integer? (denom rat))) + (if (and (number? (numer rat)) + (number? (denom rat))) ((get 'make 'real) (/ (numer rat) (denom rat))) (list 'undefined))) @@ -120,6 +120,8 @@ (lambda (x y) (tagme (div-rat x y)))) (put 'raise '(rational) raiseme) (put 'project '(rational) dropme) + ;; expt for integerizing factor + (put 'expt '(rational rational) (lambda (r1 r2) (expt (raiseme r1) (raiseme r2)))) ;; sqrt and trig methods for complex nums (put 'sqr '(rational) (lambda (r) (sqr (raiseme r)))) (put 'sqrt '(rational) (lambda (r) (sqrt (raiseme r)))) diff --git a/coding-exercises/2/83/install-real.rkt b/coding-exercises/2/83/install-real.rkt index a232e5e..2141059 100644 --- a/coding-exercises/2/83/install-real.rkt +++ b/coding-exercises/2/83/install-real.rkt @@ -35,6 +35,8 @@ (put 'project '(real) (lambda (n) ((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 'expt '(real real) expt) ;; sqrt and trig methods for complex nums (put 'sqr '(real) sqr) (put 'sqrt '(real) sqrt) diff --git a/coding-exercises/2/83/polynomials.rkt b/coding-exercises/2/83/polynomials.rkt index c400992..37231fd 100644 --- a/coding-exercises/2/83/polynomials.rkt +++ b/coding-exercises/2/83/polynomials.rkt @@ -58,6 +58,26 @@ (apply-fn 'neg (cdr term)))) termlist)) + (define (iter-terms result fn terms) + (cond ((empty-termlist? terms) result) + (else (iter-terms + (fn (first-term terms) result) + fn + (rest-terms terms))))) + + (define (gcd-sparse-termlist termlist) + (newline) + (newline) + (display (list "GCD-SPARSE-TERMLIST --" (apply-fn 'coeff (first-term termlist)) termlist)) + (newline) + (iter-terms (apply-fn 'coeff (first-term termlist)) + (lambda (term result) + (newline) + (display (list "GCD-SPARSE-TERMLIST TRACE --" term result)) + (newline) + (apply-fn 'greatest-common-divisor (apply-fn 'coeff term) result)) + (rest-terms termlist))) + ;; convert term contents to our format (define (term-contents->order-coeff-pair term) (cons (order term) @@ -94,7 +114,9 @@ (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))))) + (put 'the-empty-termlist 'sparse-termlist (lambda () (tagme (the-empty-termlist)))) + ;; returns number + (put 'gcd '(sparse-termlist) (lambda (termlist) (gcd-sparse-termlist termlist)))) (define (install-dense-termlist-package get put apply-fn) ;; methods imported from term package @@ -353,18 +375,87 @@ (let ((result-remainder-list (div-terms L1 L2))) (cadr result-remainder-list))) - (define (gcd-terms a b) + (define (pseudoremainder-terms P Q) + (newline) + (display (list "PSEUDOREMAINDER-TERMS --" P Q)) + (newline) + (newline) + (display (list "PSEUDOREMAINDER-TERMS order --" (first-term P) (first-term Q))) (newline) (newline) + (let ((O1 (order (first-term P))) + (O2 (order (first-term Q))) + (c (coeff (first-term Q)))) + (let ((integerizing-factor (apply-fn 'expt c (+ 1 O1 (- O2))))) + (display (list "INTEGERIZING-FACTOR --" c (+ 1 O1 (- O2)) integerizing-factor)) + (let ((integerized-p (mul-terms + (make-term-list (list (make-term 0 integerizing-factor))) + P))) + (let ((result-remainder-list (div-terms integerized-p Q))) + (cadr result-remainder-list)))))) + + + ;; 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) + (let ((g (apply-fn 'gcd a))) + (newline) + (newline) + (display (list "GCD-TERMS result gcd --" g a)) + (newline) + (newline) + (let ((common-factors-removed-a (div-terms + a + (make-term-list (list (make-term 0 g)))))) + + (get-if-divided common-factors-removed-a)))) + + (define (get-if-divided a) + (if (empty-termlist? (cadr a)) + (car a) + (error "GET-IF-DIVIDED -- did not divide"))) + + (define (gcd-terms a b) + (newline) (display (list a b (empty-termlist? b))) + (newline) (if (empty-termlist? b) - a - (gcd-terms b (remainder-terms a b)))) + (remove-common-factors a) + (gcd-terms b (pseudoremainder-terms a b)))) + + (define (reduce-terms n d) + (let ((g (gcd-terms n d)) + (O1 (max (coeff (first-term n)) + (coeff (first-term d))))) + (newline) + (display (list "REDUCE-TERMS g --" g)) + (newline) + (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))))) + + (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)) + (make-poly + (variable p1) + (cadr reduced-polies)))) + (error "Polys not in same var -- ADD-POLY" (list p1 p2)))) (define (gcd-poly p1 p2) (newline) (newline) (display (list p1 p2)) + (newline) (if (same-variable? (variable p1) (variable p2)) (cons @@ -393,6 +484,7 @@ (rec (term-list poly))) (put '=zero? '(polynomial) polynomial-=zero?) ;;interface + (put 'reduce '(polynomial polynomial) (lambda (p1 p2) (tagme (reduce-poly p1 p2)))) (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) diff --git a/coding-exercises/2/93.rkt b/coding-exercises/2/93.rkt index 5eb7221..f9734b8 100644 --- a/coding-exercises/2/93.rkt +++ b/coding-exercises/2/93.rkt @@ -53,14 +53,32 @@ (define q1 (mul p1 p2)) (define q2 (mul p1 p3)) (newline) + (display q1) (newline) + (display q2) (newline) (newline) (newline) - (display q1) (newline) - (display q2) (newline) - (display (greatest-common-divisor q1 q2)))) + (display (list "GREATEST-COMMON-DIVISOR" (greatest-common-divisor q1 q2))))) ;; 96 +;; integerizing factor is the c^{1+order of P-order of Q} +;; division by first multiplying the dividend by this constant is called pseudo division + +;; 97 +(define (reduce n d) + (apply-fn 'reduce n d)) +((lambda () + (define p1 (make-polynomial 'x + (sparse-termlist + (term 1 6) + (term 0 1)))) + (define p2 (make-polynomial 'x + (sparse-termlist + (term 1 6)))) + (newline) + (display (list "REDUCE call")) + (newline) + (display (list "REDUCE result --" (reduce p1 p2))))) |