From f5409662d478093ebb79fdb308538be7bf42f701 Mon Sep 17 00:00:00 2001 From: Mike Vink Date: Sun, 23 Apr 2023 22:23:23 +0200 Subject: fixup --- coding-exercises/2/78/install-complex-package.rkt | 73 +++++++++++++++++++++++ 1 file changed, 73 insertions(+) create mode 100644 coding-exercises/2/78/install-complex-package.rkt (limited to 'coding-exercises/2/78/install-complex-package.rkt') diff --git a/coding-exercises/2/78/install-complex-package.rkt b/coding-exercises/2/78/install-complex-package.rkt new file mode 100644 index 0000000..a656495 --- /dev/null +++ b/coding-exercises/2/78/install-complex-package.rkt @@ -0,0 +1,73 @@ +#lang racket +(provide install-complex-package) +(require "../../../shared/data-directed-programming.rkt") +(require "./complex-rectangular.rkt") +(require "./complex-polar.rkt") + + +(define (install-complex-package apply-generic get put) + ;; install and import methods + (install-rectangular-package put) + (install-polar-package put) + (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)) + + (define (real-part z) + (apply-generic 'real-part z)) + (define (imag-part z) + (apply-generic 'imag-part z)) + (define (magnitude z) + (apply-generic 'magnitude z)) + (define (angle z) + (apply-generic 'angle z)) + + ;; internal + (define (add-complex z1 z2) + (make-from-real-imag (+ (real-part z1) (real-part z2)) + (+ (imag-part z1) (imag-part z2)))) + (define (sub-complex z1 z2) + (make-from-real-imag (- (real-part z1) (real-part z2)) + (- (imag-part z1) (imag-part z2)))) + (define (mul-complex z1 z2) + (make-from-mag-ang (* (magnitude z1) (magnitude z2)) + (+ (angle z1) (angle z2)))) + (define (div-complex z1 z2) + (make-from-mag-ang (/ (magnitude z1) (magnitude z2)) + (- (angle z1) (angle z2)))) + + ;; predicates (...) -> bool + (define (equ? z1 z2) + (and (equal? (real-part z1) (real-part z2)) + (equal? (imag-part z1) (imag-part z2)))) + (define (=zero? z) + (and (= (real-part z)) (= (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 '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) (equ? z1 z2))) + (put '=zero? '(complex) + (lambda (z1) (=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)))) + 'done) + -- cgit v1.2.3