From: Ramakrishnan Muthukrishnan Date: Sun, 19 Sep 2010 18:46:23 +0000 (+0530) Subject: code from section 2.4 X-Git-Url: https://git.rkrishnan.org/components/com_hotproperty/frontends/%22file:/$rel_link?a=commitdiff_plain;h=c3f614772016c37f6ca44a3ae6c752b944ca3753;p=sicp.git code from section 2.4 --- diff --git a/src/sicp/ch2_4.rkt b/src/sicp/ch2_4.rkt new file mode 100644 index 0000000..ed348fd --- /dev/null +++ b/src/sicp/ch2_4.rkt @@ -0,0 +1,106 @@ +#lang racket + +(require "utils.rkt") + + +; section 2.4 +(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)))) + +;;; constructors and selectors for rectangular form +(define (real-part-rect z) (car z)) +(define (imag-part-rect z) (cdr z)) + +(define (magnitude-rect z) + (sqrt (+ (square (real-part-rect z)) + (square (imag-part-rect z))))) + +(define (angle-rect z) + (atan (imag-part-rect z) (real-part-rect z))) + +(define (make-from-real-imag-rect x y) (attach-tag 'rectangular (cons x y))) + +(define (make-from-mag-ang-rect r a) + (attach-tag 'rectangular (cons (* r (cos a)) (* r (sin a))))) + +;;; constructors and selectors for polar form +(define (real-part-polar z) (* (magnitude-polar z) + (cos (angle-polar z)))) + +(define (imag-part-polar z) (* (magnitude-polar z) + (sin (angle-polar z)))) + +(define (magnitude-polar z) (car z)) +(define (angle-polar z) (cdr z)) + +(define (make-from-real-imag x y) + (attach-tag 'polar + (cons (sqrt (+ (square x) (square y))) + (atan y x)))) + +(define (make-from-mag-ang r a) (attach-tag 'polar (cons r a))) + +;; type tag +(define (attach-tag type-tag contents) + (cons type-tag contents)) + +(define (type-tag datum) + (if (pair? datum) + (car datum) + (error "Bad tagged datum -- TYPE-TAG" datum))) + +(define (contents datum) + (if (pair? datum) + (cdr datum) + (error "Bad tagged datum -- CONTENTS" datum))) + +(define (rectangular? z) + (eq? (type-tag z) 'rectangular)) + +(define (polar? z) + (eq? (type-tag z) 'polar)) + +;; generic procedures +(define (real-part z) + (cond + [(rectangular? z) (real-part-rect (contents z))] + [(polar? z) (real-part-polar (contents z))] + [else (error "unknown type -- real-part" z)])) + +(define (imag-part z) + (cond + [(rectangular? z) (imag-part-rect (contents z))] + [(polar? z) (imag-part-rect (contents z))] + [else (error "unknown type -- imag part" z)])) + +(define (magnitude z) + (cond + [(rectangular? z) (magnitude-rect (contents z))] + [(polar? z) (magnitude-polar (contents z))] + [else (error "Unknown type -- MAGNITUDE" z)])) + +(define (angle z) + (cond [(rectangular? z) (angle-rect (contents z))] + [(polar? z) (angle-polar (contents z))] + [else (error "Unknown type -- ANGLE" z)])) + +(define (make-from-real-imag x y) + (make-from-real-imag-rect x y)) + +(define (make-from-mag-ang r a) + (make-from-mag-ang-polar r a)) + +;;; data directed programming