SICP ex2-50

本次要求在之前三个类型的数据及存在相应的操作运算符的情况下将这些运算符统一化

采用的是data-directed的方式

需要注意的是要区分complex 内部的data-directed 以及运算符的data-directed

其他基本没有什么难度

;;put and get
(define (make-table)
(let ((local-table (list '*table*)))
(define (lookup key-1 key-2)
(let ((subtable (assoc key-1 (cdr local-table))))
(if subtable
(let ((record (assoc key-2 (cdr subtable))))
(if record
(cdr record)
false))
false)))
(define (insert! key-1 key-2 value)
(let ((subtable (assoc key-1 (cdr local-table))))
(if subtable
(let ((record (assoc key-2 (cdr subtable))))
(if record
(set-cdr! record value)
(set-cdr! subtable
(cons (cons key-2 value) (cdr subtable)))))
(set-cdr! local-table
(cons (list key-1 (cons key-2 value)) (cdr local-table)))))
'OK)
(define (dispatch m)
(cond ((eq? m 'lookup-proc) lookup)
((eq? m 'insert-proc) insert!)
(else (error "Unknown operation -- TABLE" m))))
dispatch))
(define operation-table (make-table))
(define get (operation-table 'lookup-proc))
(define put (operation-table 'insert-proc))

;;number
(define (num+ x y) (make-number (+ x y)))
(define (num- x y) (make-number (- x y)))
(define (num* x y) (make-number (* x y)))
(define (num/ x y) (make-number (/ x y)))
(define (make-number n) n)

;;rational
(define (denominator z) (cdr z))
(define (numerator z) (car z))
(define (rat+ x y)
(make-rat
(+ (* (numerator x) (denominator y)) (* (numerator y) (denominator x)))
(* (denominator x) (denominator y))))
(define (rat- x y)
(make-rat
(- (* (numerator x) (denominator y)) (* (numerator y) (denominator x)))
(* (denominator x) (denominator y))))
(define (rat* x y)
(make-rat
(* (numerator x) (numerator y)) (* (denominator x) (denominator y))))
(define (rat/ x y)
(make-rat
(* (numerator x) (denominator y)) (* (numerator y) (denominator x))))
(define (make-rat x y)
(define (reminder x y) (if (< x y) x (reminder (- x y) y)))
(define (gcd x y)
(let ((small (if (< x y) x y))
(big (if (< x y) y x)))
(define (iter x y)
(if
(= 0 (reminder x y))
y
(iter x (- y 1))))
(iter big small)))
(let ((tmp (gcd x y)))
(cons 'rational (cons (/ x tmp) (/ y tmp)))))

(put 'number 'add num+)
(put 'number 'sub num-)
(put 'number 'mul num*)
(put 'number 'div num/)
(put 'rational 'add rat+)
(put 'rational 'sub rat-)
(put 'rational 'mul rat*)
(put 'rational 'div rat/)

(define (type z) (if (number? z) 'number (car z)))
(define (content z) (if (number? z) z (cdr z)))
(define (add x y)
(operate 'add x y))
(define (sub x y)
(operate 'sub x y))
(define (mul x y)
(operate 'mul x y))
(define (div x y)
(operate 'div x y))

(define (operate op obj1 obj2)
(cond
((not (eq? (type obj1) (type obj2))) (error "Not same type"))
(else
((get (type obj1) op) (content obj1) (content obj2)))))

;;complex
;constructor
(define (complex-attach-type type content)
(cons type content))
(define (complex-type z)
(if
(pair? z)
(car z)
(error "error data")))
(define (complex-content z)
(if
(pair? z)
(cdr z)
(error "error data")))
(define (rectangle? z)
(eq? (complex-type z) 'rectangle))
(define (polar? z)
(eq? (complex-type z) 'polar))
(define (make-rectangle x y)
(complex-attach-type 'rectangle (cons x y)))
(define (make-polar r a)
(complex-attach-type 'polar (cons r a)))

;;selector
(define (rectangle-real-part obj)
(car obj))
(define (rectangle-imag-part obj)
(cdr obj))
(define (rectangle-magnitude obj)
(sqrt (+ (square (car obj)) (square (cdr obj)))))
(define (rectangle-angle obj)
(atan (car obj) (cdr obj)))
(define (polar-real-part obj)
(* (car obj) (cos (cdr obj))))
(define (polar-imag-part obj)
(* (car obj) (sin (cdr obj))))
(define (polar-magnitude obj)
(car obj))
(define (polar-angle obj)
(cdr obj))

(put 'rectangle 'real-part rectangle-real-part)
(put 'polar 'real-part polar-real-part)
(put 'rectangle 'imag-part rectangle-imag-part)
(put 'polar 'imag-part polar-imag-part)
(put 'rectangle 'magnitude rectangle-magnitude)
(put 'polar 'magnitude polar-magnitude)
(put 'rectangle 'angle rectangle-angle)
(put 'polar 'angle polar-angle)

(define (complex-operate op obj)
(let ((proc (get (complex-type obj) op)))
(if
(null? proc)
(error "no this type" (list op obj))
(proc (complex-content obj)))))

(define (real-part obj)
(complex-operate 'real-part obj))
(define (imag-part obj)
(complex-operate 'imag-part obj))
(define (magnitude obj)
(complex-operate 'magnitude obj))
(define (angle obj)
(complex-operate 'angle obj))

;;operator
(define (+c z1 z2)
(make-complex (make-rectangle (+ (real-part z1) (real-part z2)) (+ (imag-part z1) (imag-part z2)))))
(define (-c z1 z2)
(make-complex (make-rectangle (- (real-part z1) (real-part z2)) (- (imag-part z1) (imag-part z2)))))
(define (*c z1 z2)
(make-complex (make-polar (* (magnitude z1) (magnitude z2)) (+ (angle z1) (angle z2)))))
(define (/c z1 z2)
(make-complex (make-polar (/ (magnitude z1) (magnitude z2)) (- (angle z1) (angle z2)))))

(define (make-complex z)
(cons 'complex z))
(define (make-rectangle-complex x y)
(make-complex (make-rectangle x y)))
(define (make-polar-complex x y)
(make-complex (make-polar x y)))
(put 'complex 'add +c)
(put 'complex 'sub -c)
(put 'complex 'mul *c)
(put 'complex 'div /c)
(put 'complex 'real-part real-part)
(put 'complex 'imag-part imag-part)
(put 'complex 'magnitude magnitude)
(put 'complex 'angle angle)
(define (c=zero? z)
(and (= 0 (real-part z)) (= 0 (imag-part z))))
(define (r=zero? z)
(and (= 0 (numerator z)) (not (= 0 (denominator z)))))
(define (n=zero? z)
(= 0 z))
(put 'complex '=zero? c=zero?)
(put 'rational '=zero? r=zero?)
(put 'number '=zero? n=zero?)
(define (=zero? z)
(let ((proc (get (type z) '=zero?)))
(proc (content z))))





另外分析下magnitude 的实现原因,首先magnitude 调用了complex-operate这个函数并将op置为magnitude 然后在函数体中调用了complex-type获取了complex这样

就获取了实数的type 并定位到了magnitude 之后，又一次按之前的步骤进行调用,获取了rectangle-magnitude的函数,到此,成果实现要求

至于利用symbol?的原操作,为了实现格式统一,我们在type判断是number的之后自动返回'number即可