summaryrefslogtreecommitdiff
path: root/coding-exercises/2
diff options
context:
space:
mode:
Diffstat (limited to 'coding-exercises/2')
-rw-r--r--coding-exercises/2/83/install-integer.rkt6
-rw-r--r--coding-exercises/2/83/install-rational.rkt6
-rw-r--r--coding-exercises/2/83/install-real.rkt2
-rw-r--r--coding-exercises/2/83/polynomials.rkt100
-rw-r--r--coding-exercises/2/93.rkt24
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)))))
generated by cgit v1.2.3 (git 2.25.1) at 2026-02-12 08:34:15 +0000