From bfdb81a05b010e51a7410f3503bfa9f43ccc2f7c Mon Sep 17 00:00:00 2001 From: Mike Vink Date: Tue, 2 May 2023 21:33:01 +0200 Subject: finally finished the arithmetic package stuff --- coding-exercises/2/78/complex-polar.rkt | 6 +-- coding-exercises/2/78/complex-rectangular.rkt | 8 ++-- coding-exercises/2/78/install-complex-package.rkt | 4 +- coding-exercises/2/83.rkt | 58 +++++++++++++++++++++-- 4 files changed, 64 insertions(+), 12 deletions(-) diff --git a/coding-exercises/2/78/complex-polar.rkt b/coding-exercises/2/78/complex-polar.rkt index 3c8cfe8..725f387 100644 --- a/coding-exercises/2/78/complex-polar.rkt +++ b/coding-exercises/2/78/complex-polar.rkt @@ -2,7 +2,7 @@ (provide install-polar-package) (require "../../../shared/data-directed-programming.rkt") -(define (install-polar-package put) +(define (install-polar-package apply-generic put) (define (magnitude z) (car z)) (define (angle z) @@ -10,9 +10,9 @@ (define (make-from-mag-ang r a) (cons r a)) (define (real-part z) - (* (magnitude z) (cos (angle z)))) + (apply-generic 'mul (magnitude z) (apply-generic 'cos (angle z)))) (define (imag-part z) - (* (magnitude z) (sin (angle z)))) + (apply-generic 'mul (magnitude z) (apply-generic 'sin (angle z)))) (define (make-from-real-imag x y) (cons (sqrt (+ (sqr x) (sqr y))) (atan y x))) diff --git a/coding-exercises/2/78/complex-rectangular.rkt b/coding-exercises/2/78/complex-rectangular.rkt index bbc2b8c..be4f0e5 100644 --- a/coding-exercises/2/78/complex-rectangular.rkt +++ b/coding-exercises/2/78/complex-rectangular.rkt @@ -3,14 +3,14 @@ (require "../../../shared/data-directed-programming.rkt") -(define (install-rectangular-package put) +(define (install-rectangular-package apply-generic put) (define (real-part z) (car z)) (define (imag-part z) (cdr z)) (define (make-from-real-imag x y) (cons x y)) - (define (magnitude z) (sqrt (+ (sqr (real-part z)) - (sqr (real-part z))))) + (define (magnitude z) (apply-generic 'sqrt (+ (apply-generic 'sqr (real-part z)) + (apply-generic 'sqr (real-part z))))) (define (angle z) - (atan (imag-part z) + (apply-generic 'atan (imag-part z) (real-part z))) (define (make-from-mag-ang r a) (cons (* r (cos a)) diff --git a/coding-exercises/2/78/install-complex-package.rkt b/coding-exercises/2/78/install-complex-package.rkt index fa39328..a99b7d5 100644 --- a/coding-exercises/2/78/install-complex-package.rkt +++ b/coding-exercises/2/78/install-complex-package.rkt @@ -7,8 +7,8 @@ (define (install-complex-package apply-generic get put) ;; install and import methods - (install-rectangular-package put) - (install-polar-package put) + (install-rectangular-package apply-generic put) + (install-polar-package apply-generic put) (define (make-from-real-imag x y) ((get 'make-from-real-imag 'rectangular) x y)) (define (make-from-mag-ang r a) diff --git a/coding-exercises/2/83.rkt b/coding-exercises/2/83.rkt index 8ea5442..bba4a57 100644 --- a/coding-exercises/2/83.rkt +++ b/coding-exercises/2/83.rkt @@ -38,6 +38,12 @@ (put 'mul '(integer integer) (lambda (x y) (tagme (make (* x y))))) (put 'div '(integer integer) (lambda (x y) (tagme (make (/ x y))))) (put 'raise '(integer) raiseme) + ;; sqrt and trig methods for complex nums + (put 'sqr '(integer) sqr) + (put 'sqrt '(integer) sqrt) + (put 'atan '(integer) atan) + (put 'cos '(integer) cos) + (put 'sin '(integer) sin) ;; predicates (put 'equ? '(integer integer) (lambda (x y) (= x y))) (put '=zero? '(integer) (lambda (x) (= 0 x))) @@ -97,6 +103,12 @@ (put 'raise '(rational) raiseme) (put 'project '(rational) (lambda (rat) ((get 'make 'integer) (/ (numer rat) (denom rat))))) + ;; sqrt and trig methods for complex nums + (put 'sqr '(rational) (lambda (r) (sqr (raiseme r)))) + (put 'sqrt '(rational) (lambda (r) (sqrt (raiseme r)))) + (put 'cos '(rational) (lambda (r) (cos (raiseme r)))) + (put 'sin '(rational) (lambda (r) (sin (raiseme r)))) + (put 'atan '(rational rational) (lambda (r1 r2) (atan (raiseme r1) (raiseme r2)))) ;; predicates (put 'equ? '(rational rational) @@ -124,6 +136,12 @@ (put 'raise '(real) raiseme) (put 'project '(real) (lambda (n) ((get 'make 'rational) (round n) 1))) + ;; sqrt and trig methods for complex nums + (put 'sqr '(real) sqr) + (put 'sqrt '(real) sqrt) + (put 'cos '(real) cos) + (put 'sin '(real) sin) + (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))) @@ -157,7 +175,13 @@ ;; complex (define (make-complex x y) ((get 'make-from-real-imag 'complex) x y)) +(define (make-complex-rect x y) + ((get 'make-from-real-imag 'complex) x y)) +(define (make-complex-polar x y) + ((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 (raisetower datum) (apply-coercion 'raise datum)) @@ -273,13 +297,41 @@ (if raised-result (towerdrop raised-result) (error "Could not apply --" (list op args raised-args))))))))) -(define apply-and-drop (make-apply-with-raising-and-drop (make-apply-pred get) get)) -(apply-and-drop 'add +(define apply-and-drop-test (make-apply-with-raising-and-drop (make-apply-pred get) get)) +(apply-and-drop-test 'add 1.0 (make-complex 1 0)) ;; 86 +;; new package +(define generic-pkg (make-dispatch-table)) +(define generic-put (putter generic-pkg)) +(define generic-get (getter generic-pkg)) +(define apply-and-drop (make-apply-with-raising-and-drop (make-apply-pred generic-get) generic-get)) +(install-integer generic-put generic-get) +(install-rational generic-put generic-get) +(install-real generic-put generic-get) +(install-complex-package apply-and-drop generic-get generic-put) +(generic-put 'project '(complex) (lambda (z) + ((generic-get 'make 'real) (apply-and-drop 'real-part z)))) ;; Selectors and constructors of complex numbers packages need to become generic ;; We can try to raise to real numbers before passing it to the trig functions, but we need to do this for every possible type in the system. ;; So it is better to let the types themselves define trig functions -(apply-generic 'angle (make-complex 1 test-rat)) +;; +;; Rectangular complex numbers: +;; 1. Make from mag angle uses cos and sin (not used by complex package however, since we always store make-from-mag-angle as polar?) +;; 2. Angle uses atan +;; 3. Magnitude uses sqr sqrt +;; Polar complex numbers: +;; 1. make from real imag uses sqr sqrt and atan (not used by complex package however, since we always store make-from-real-imag as rectangular?) +;; 2. Selectors use sine and cos +;; +;; So at these for points we can try to raise to real numbers, but then it doesn't work +;; for all numbers we potentially want to add to the system. +;; So we are going to add these generic operations to the complex package. +;; NOTE(mike): mixed types are not supported in my system, but they could be if we use the raising apply generic probably! +;; for example we can mul a real and rational with the raising applier +(apply-and-drop 'angle (make-complex-rect test-rat test-rat)) +(apply-and-drop 'magnitude (make-complex-rect test-rat test-rat)) +(apply-and-drop 'real-part (make-complex-polar test-rat test-rat)) +(apply-and-drop 'imag-part (make-complex-polar test-rat test-rat)) -- cgit v1.2.3