From d1bfadf2a338c25cb19ee2043501b293ea2081b3 Mon Sep 17 00:00:00 2001 From: Mike Vink Date: Sun, 7 May 2023 16:36:29 +0200 Subject: fix some bugs while doing 91 --- coding-exercises/2/83/install-complex.rkt | 207 +++++++++++++++++++++++++++++- coding-exercises/2/83/install-real.rkt | 8 +- coding-exercises/2/83/install.rkt | 3 +- 3 files changed, 209 insertions(+), 9 deletions(-) (limited to 'coding-exercises/2/83') diff --git a/coding-exercises/2/83/install-complex.rkt b/coding-exercises/2/83/install-complex.rkt index 17b479f..e3dfe52 100644 --- a/coding-exercises/2/83/install-complex.rkt +++ b/coding-exercises/2/83/install-complex.rkt @@ -1,9 +1,204 @@ #lang racket (provide install-complex) -(require "../78/install-complex-package.rkt" - "../../../shared/data-directed-programming.rkt") +(require "../../../shared/data-directed-programming.rkt") -(define (install-complex apply-and-drop get put) - (install-complex-package apply-and-drop get put) - (put 'project '(complex) (lambda (z) - ((get 'make 'real) (apply-and-drop 'real-part z))))) +(define (install-rectangular-package apply-fn put) + ;; import methods + (define (add a b) + (apply-fn 'add a b)) + (define (sub a b) + (apply-fn 'sub a b)) + (define (mul a b) + (apply-fn 'mul a b)) + (define (div a b) + (apply-fn 'div a b)) + (define (cos a) + (apply-fn 'cos a)) + (define (sin a) + (apply-fn 'sin a)) + (define (sqr a) + (apply-fn 'sqr a)) + (define (sqrt a) + (apply-fn 'sqrt a)) + (define (atan a b) + (apply-fn 'atan a b)) + + ;; selectors + (define (real-part z) (car z)) + (define (imag-part z) (cdr z)) + + ;; generic selectors + (define (magnitude z) (sqrt (add (sqr (real-part z)) + (sqr (imag-part z))))) + (define (angle z) (atan (imag-part z) (real-part z))) + + ;; constructors + (define (make-from-real-imag x y) (cons x y)) + (define (make-from-mag-ang r a) + (cons (mul r (cos a)) + (mul r (sin a)))) + + ;; interface part + (define (typtag x) + (attach-tag 'rectangular x)) + + (put 'real-part '(rectangular) real-part) + (put 'imag-part '(rectangular) imag-part) + (put 'magnitude '(rectangular) magnitude) + (put 'angle '(rectangular) angle) + (put 'make-from-real-imag 'rectangular + (lambda (x y) (typtag (make-from-real-imag x y)))) + (put 'make-from-mag-ang 'rectangular + (lambda (r a) (typtag (make-from-mag-ang r a)))) + 'done) + +(define (install-polar-package apply-fn put) + ;; import methods + (define (mul a b) + (apply-fn 'mul a b)) + (define (cos a) + (apply-fn 'cos a)) + (define (sin a) + (apply-fn 'sin a)) + (define (sqr a) + (apply-fn 'sqr a)) + (define (sqrt a) + (apply-fn 'sqrt a)) + (define (atan a b) + (apply-fn 'atan a b)) + + ;; selectors + (define (magnitude z) + (car z)) + (define (angle z) + (cdr z)) + (define (make-from-mag-ang r a) + (cons r a)) + + ;; generic selectors + (define (real-part z) + (mul (magnitude z) + (cos (angle z)))) + (define (imag-part z) + (mul (magnitude z) + (sin (angle z)))) + + ;; constructor + (define (make-from-real-imag x y) + (cons (sqrt (+ (sqr x) (sqr y))) + (atan y x))) + + ;; register in data-driven package) + (define (typtag x) + (attach-tag 'polar x)) + (put 'real-part '(polar) real-part) + (put 'imag-part '(polar) imag-part) + (put 'magnitude '(polar) magnitude) + (put 'angle '(polar) angle) + (put 'make-from-real-imag 'polar (lambda (x y) (typtag (make-from-real-imag x y)))) + (put 'make-from-mag-ang 'polar (lambda (r a) (typtag (make-from-mag-ang r a)))) + 'done) + +(define (install-complex apply-fn get put) + ;; import methods + (define (add a b) + (apply-fn 'add a b)) + (define (sub a b) + (apply-fn 'sub a b)) + (define (mul a b) + (apply-fn 'mul a b)) + (define (div a b) + (apply-fn 'div a b)) + (define (cos a) + (apply-fn 'cos a)) + (define (sin a) + (apply-fn 'sin a)) + (define (sqr a) + (apply-fn 'sqr a)) + (define (sqrt a) + (apply-fn 'sqrt a)) + (define (atan a b) + (apply-fn 'atan a b)) + (define (=zero? a) + (apply-fn '=zero? a)) + (define (equ? a b) + (apply-fn 'equ? a b)) + (install-rectangular-package apply-fn put) + (install-polar-package apply-fn put) + + ;; constructors + (define (make-from-real-imag x y) + ((get 'make-from-real-imag 'rectangular) x y)) + (define (make-from-mag-ang r a) + ((get 'make-from-mag-ang 'polar) r a)) + + ;; selectors + (define (real-part z) + (apply-fn 'real-part z)) + (define (imag-part z) + (apply-fn 'imag-part z)) + (define (magnitude z) + (apply-fn 'magnitude z)) + (define (angle z) + (apply-fn 'angle z)) + + ;; internal + (define (add-complex z1 z2) + (make-from-real-imag (add (real-part z1) (real-part z2)) + (add (imag-part z1) (imag-part z2)))) + (define (sub-complex z1 z2) + (make-from-real-imag (sub (real-part z1) (real-part z2)) + (sub (imag-part z1) (imag-part z2)))) + (define (mul-complex z1 z2) + (make-from-mag-ang (mul (magnitude z1) (magnitude z2)) + (add (angle z1) (angle z2)))) + (define (div-complex z1 z2) + (newline) + (display "DIV-COMPLEX") + (newline) + (display (list z1 z2)) + (newline) + (display (list (magnitude z1) (magnitude z2))) + (make-from-mag-ang (div (magnitude z1) (magnitude z2)) + (sub (angle z1) (angle z2)))) + + ;; predicates (...) -> bool + (define (complex-equ? z1 z2) + (and (equ? (real-part z1) (real-part z2)) + (equ? (imag-part z1) (imag-part z2)))) + (define (complex-=zero? z) + (and (=zero? (real-part z)) + (=zero? (imag-part z)))) + + ;; interface + (define (typetag z) (attach-tag 'complex z)) + (put 'real-part '(complex) real-part) + (put 'imag-part '(complex) imag-part) + (put 'magnitude '(complex) magnitude) + (put 'angle '(complex) angle) + + (put 'add '(complex complex) + (lambda (z1 z2) (typetag (add-complex z1 z2)))) + (put 'neg '(complex) + (lambda (z) (typetag (make-from-real-imag (- (real-part z)) + (- (imag-part z)))))) + (put 'sub '(complex complex) + (lambda (z1 z2) (typetag (sub-complex z1 z2)))) + (put 'mul '(complex complex) + (lambda (z1 z2) (typetag (mul-complex z1 z2)))) + (put 'div '(complex complex) + (lambda (z1 z2) (typetag (div-complex z1 z2)))) + + (put 'equ? '(complex complex) + (lambda (z1 z2) (complex-equ? z1 z2))) + (put '=zero? '(complex) + (lambda (z1) (complex-=zero? z1))) + + (put 'make-from-real-imag 'complex + (lambda (x y) (typetag (make-from-real-imag x y)))) + (put 'make-from-mag-ang 'complex + (lambda (r a) (typetag (make-from-mag-ang r a)))) + + (put 'project '(complex) (lambda (z) + ((get 'make 'real) (apply-fn 'real-part z)))) + 'done) diff --git a/coding-exercises/2/83/install-real.rkt b/coding-exercises/2/83/install-real.rkt index 6b96137..356ac92 100644 --- a/coding-exercises/2/83/install-real.rkt +++ b/coding-exercises/2/83/install-real.rkt @@ -3,11 +3,15 @@ (require "../../../shared/data-directed-programming.rkt") (define (install-real put get) + (define threshold 0.00001) ;; local methods (define (tagme datum) (attach-tag 'real datum)) (define (make i) - (exact->inexact i)) + (let ((n (exact->inexact i))) + (if (< n threshold) + 0.0 + n))) (define (raiseme r) ((get 'make-from-real-imag 'complex) r 0)) ;; constructor @@ -29,5 +33,5 @@ (put 'atan '(real real) (lambda (x y) (atan x y))) ;; predicates (put 'equ? '(real real) (lambda (x y) (= x y))) - (put '=zero? '(real) (lambda (x) (= 0 x))) + (put '=zero? '(real) (lambda (x) (< x threshold))) 'done) diff --git a/coding-exercises/2/83/install.rkt b/coding-exercises/2/83/install.rkt index d972784..3f923f0 100644 --- a/coding-exercises/2/83/install.rkt +++ b/coding-exercises/2/83/install.rkt @@ -73,7 +73,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-rect 1 2)) +(define test-complex-polar (make-complex-polar (apply-fn 'magnitude test-complex) + (apply-fn 'angle test-complex))) ;; polynomial (define (make-polynomial var terms) -- cgit v1.2.3