diff options
| -rw-r--r-- | coding-exercises/2/83/install-integer.rkt | 25 | ||||
| -rw-r--r-- | coding-exercises/2/83/install-rational.rkt | 24 | ||||
| -rw-r--r-- | coding-exercises/2/83/install-real.rkt | 10 | ||||
| -rw-r--r-- | coding-exercises/2/83/install.rkt | 8 | ||||
| -rw-r--r-- | coding-exercises/2/83/polynomials.rkt | 43 | ||||
| -rw-r--r-- | coding-exercises/2/93.rkt | 22 | ||||
| -rw-r--r-- | shared/data-directed-programming.rkt | 3 |
7 files changed, 121 insertions, 14 deletions
diff --git a/coding-exercises/2/83/install-integer.rkt b/coding-exercises/2/83/install-integer.rkt index ca1ebb5..ca33ba0 100644 --- a/coding-exercises/2/83/install-integer.rkt +++ b/coding-exercises/2/83/install-integer.rkt @@ -13,13 +13,26 @@ ((get 'make 'rational) i 1) (error "cannot raise non integer in integer package"))) ;; constructor - (put 'make 'integer (lambda (x) (tagme (make x)))) + (put 'make 'integer (lambda (x) + (newline) + (display (list "MAKE INTEGER --" x (make x))) + (tagme (make x)))) + + (define (gcd-integer a b) + (newline) + (display (list "GCD-INTEGER -- " a b)) + (if (= b 0) + a + (gcd-integer b (remainder a b)))) + ;; methods - (put 'add '(integer integer) (lambda (x y) (tagme (make (+ x y))))) - (put 'neg '(integer) (lambda (x) (tagme (- x)))) - (put 'sub '(integer integer) (lambda (x y) (tagme (make (- x y))))) - (put 'mul '(integer integer) (lambda (x y) (tagme (make (* x y))))) - (put 'div '(integer integer) (lambda (x y) (tagme (make (/ x y))))) + (put 'add '(integer integer) (lambda (x y) (+ x y))) + (put 'neg '(integer) (lambda (x) (- x))) + (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 'raise '(integer) raiseme) ;; sqrt and trig methods for complex nums (put 'sqr '(integer) sqr) diff --git a/coding-exercises/2/83/install-rational.rkt b/coding-exercises/2/83/install-rational.rkt index 92531ec..127871a 100644 --- a/coding-exercises/2/83/install-rational.rkt +++ b/coding-exercises/2/83/install-rational.rkt @@ -17,6 +17,8 @@ (define (mul a b) (apply-fn 'mul a b)) (define (div a b) + (newline) + (display (list "Calling div from rat package" a b)) (apply-fn 'div a b)) (define (cos a) (apply-fn 'cos a)) @@ -29,8 +31,28 @@ (define (atan a b) (apply-fn 'atan a b)) + (define (gcd a b) + (newline) + (newline) + (display (list "GCD RATIONAL -- " a b)) + (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)))))) + + ;; constructor and selectors - (define (make-rat n d) (list n d)) + (define (make-rat n d) + (let ((g (gcd n d))) + (let ((numer-div (get 'div (list (type-tag n) (type-tag g)))) + (denom-div (get 'div (list (type-tag d) (type-tag g))))) + (if (and numer-div denom-div) + (list (numer-div (contents n) (contents g)) + (denom-div (contents d) (contents g))) + (list n d))))) + + + (define (numer x) (car x)) (define (denom x) (cadr x)) diff --git a/coding-exercises/2/83/install-real.rkt b/coding-exercises/2/83/install-real.rkt index d82d48a..a232e5e 100644 --- a/coding-exercises/2/83/install-real.rkt +++ b/coding-exercises/2/83/install-real.rkt @@ -17,6 +17,15 @@ ;; constructor (put 'make 'real (lambda (x) (tagme (make x)))) ;; methods + + (define (gcd-real a b) + (if (and (integer? a) + (integer? b)) + (if (= b 0) + a + (gcd-real b (remainder a b))) + a)) + (put 'add '(real real) (lambda (x y) (tagme (make (+ x y))))) (put 'neg '(real) (lambda (x) (tagme (make (- x))))) (put 'sub '(real real) (lambda (x y) (tagme (make (- x y))))) @@ -25,6 +34,7 @@ (put 'raise '(real) raiseme) (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)))) ;; sqrt and trig methods for complex nums (put 'sqr '(real) sqr) (put 'sqrt '(real) sqrt) diff --git a/coding-exercises/2/83/install.rkt b/coding-exercises/2/83/install.rkt index 25f2152..010f89d 100644 --- a/coding-exercises/2/83/install.rkt +++ b/coding-exercises/2/83/install.rkt @@ -31,7 +31,8 @@ sqrme sqrtme raiseme - dropme) + dropme + greatest-common-divisor) (require "./install-integer.rkt" "./install-rational.rkt" @@ -82,7 +83,8 @@ ((get 'make-from-mag-ang 'complex) x y)) (define test-complex (make-complex 1 2)) (define test-complex-rect (make-complex-rect 1 2)) -(define test-complex-polar (make-complex-polar (apply-fn 'magnitude test-complex) (apply-fn 'angle test-complex))) +; (define test-complex-polar (make-complex-polar (apply-fn 'magnitude test-complex) (apply-fn 'angle test-complex))) +(define test-complex-polar '()) ;; polynomial (define (term order coeff) @@ -133,3 +135,5 @@ (apply-fn 'sin datum)) (define (atanme a1 a2) (apply-fn 'atan a2)) +(define (greatest-common-divisor p1 p2) + (apply-fn 'greatest-common-divisor p1 p2)) diff --git a/coding-exercises/2/83/polynomials.rkt b/coding-exercises/2/83/polynomials.rkt index d9d25cc..c400992 100644 --- a/coding-exercises/2/83/polynomials.rkt +++ b/coding-exercises/2/83/polynomials.rkt @@ -321,14 +321,22 @@ (error "Polys not in same var -- MUL-POLY" (list p1 p2)))) (define (div-terms L1 L2) + (newline) + (newline) + (display (list "DIV-TERMS -- " L1 L2)) + (newline) (if (empty-termlist? L1) - (list (the-empty-termlist L1) (the-empty-termlist L1)) + (list (the-empty-termlist L1) + (the-empty-termlist L1)) (let ((t1 (first-term L1)) (t2 (first-term L2))) (if (> (order t2) (order t1)) (list (the-empty-termlist L1) L1) (let ((new-c (div (coeff t1) (coeff t2))) (new-o (sub (order t1) (order t2)))) + (newline) + (display (list "NEW-TERM coeff --" new-c (type-tag (coeff t1)) + (type-tag (coeff t2)))) (let ((rest-of-result (div-terms (sub-terms L1 (mul-terms @@ -341,15 +349,42 @@ (car rest-of-result)) (cadr rest-of-result)))))))) - (define (div-poly p1 p2) + (define (remainder-terms L1 L2) + (let ((result-remainder-list (div-terms L1 L2))) + (cadr result-remainder-list))) + + (define (gcd-terms a b) + (newline) + (newline) + (display (list a b (empty-termlist? b))) + (if (empty-termlist? b) + a + (gcd-terms b (remainder-terms a b)))) + + (define (gcd-poly p1 p2) + (newline) + (newline) + (display (list p1 p2)) (if (same-variable? (variable p1) (variable p2)) (cons (variable p1) - (div-terms (term-list p1) + (gcd-terms (term-list p1) (term-list p2))) (error "Polys not in same var -- DIV-POLY" (list p1 p2)))) + (define (div-poly p1 p2) + (if (same-variable? (variable p1) + (variable p2)) + (let ((result (div-terms (term-list p1) + (term-list p2)))) + (if (empty-termlist? (cadr result)) + (cons (variable p1) + (car result)) + (cons (variable p1) + result))) + (error "Polys not in same var -- DIV-POLY" (list p1 p2)))) + (define (polynomial-=zero? poly) (define (rec term-list) (cond ((empty-termlist? term-list) true) @@ -366,4 +401,6 @@ (put 'div '(polynomial polynomial) (lambda (p1 p2) (tagme (div-poly p1 p2)))) (put 'make 'polynomial (lambda (var terms) (tagme (make-poly var terms)))) + (put 'greatest-common-divisor '(polynomial polynomial) (lambda (a b) (tagme (gcd-poly a b)))) + 'done) diff --git a/coding-exercises/2/93.rkt b/coding-exercises/2/93.rkt index 4fe754e..2543b23 100644 --- a/coding-exercises/2/93.rkt +++ b/coding-exercises/2/93.rkt @@ -15,6 +15,24 @@ (define rf (make-rat p2 p1)) ((lambda () (newline) - (display rf) (newline) - (display (add rf rf)))) + (newline) + (newline) + (display (list "RESULT --" rf)) + (newline) + (newline) + (display (list "RESULT --" (add rf rf))) + (newline) + (newline) + (define test-p1 (make-polynomial 'x + (sparse-termlist + (term 4 1) + (term 3 -1) + (term 2 -2) + (term 1 2)))) + (define test-p2 (make-polynomial 'x + (sparse-termlist + (term 3 1) + (term 1 -1)))) + + (display (list "RESULT GCD --" (greatest-common-divisor test-p1 test-p2))))) diff --git a/shared/data-directed-programming.rkt b/shared/data-directed-programming.rkt index 3e555ee..84714a3 100644 --- a/shared/data-directed-programming.rkt +++ b/shared/data-directed-programming.rkt @@ -27,6 +27,7 @@ ((symbol? datum) 'symbol) ((exact-integer? datum) 'integer) ((inexact-real? datum) 'real) + ((rational? datum) 'real) ((number? datum) 'scheme-number) ((boolean? datum) 'boolean) (else (error "Bad tagged datum -- TYPE-TAG" datum)))) @@ -53,6 +54,7 @@ (newline) (println dispatch-table)) (define (get op types) + ; (display (list "GET -- " op types)) (let ((op-datum (find-type op dispatch-table))) (if op-datum (let ((proc-datum (find-type types (contents op-datum)))) @@ -247,6 +249,7 @@ datum)) (lambda (op . args) + ; (display (list "APPLY -- " op args)) (let ((proc (get op (map type-tag args)))) (if proc (towerdrop (apply proc (map contents args))) |