【SICP练习】101 练习2.77-2.78
2015-09-08 00:00
393 查看
练习2.77
我们首先来看看题目中描述的问题,当Louis Reasoner试着求值(magnitude z)时,程序中不断的寻找。一开始是通过apply-generic、而后是map,最后是get。这三个函数在书中都有很好的解释,我自知才疏学浅就不介绍了。最后一步的get中,最后由于找不到匹配的参数而返回了#f。而在Alyssa的程序中则不然。具体请看代码。(define (install-rectangular-package) (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 (+ (square (real-part z)) (square (imag-part z))))) (define (angle z) (atan (imag-part z) (real-part z))) (define (make-from-mag-ang r a) (cons (* r (cos a)) (* r (sin a)))) (define (tag 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) (tag (make-from-real-imag x y)))) (put 'make-from-mag-ang 'rectangular (lambda (r a) (tag (make-from-mag-ang r a)))) 'done) (define (make-from-real-imag x y) ((get 'make-from-real-imag 'rectangular) x y)) (define (install-polar-package) (define (magnitude z) (car z)) (define (angle z) (cdr z)) (define (make-from-mag-ang r a) (cons r a)) (define (real-part z) (* (magnitude z) (cos (angle z)))) (define (imag-part z) (* (magnitude z) (sin (angle z)))) (define (make-from-real-imag x y) (cons (sqrt (+ (square x) (square y))) (atan y x))) (define (tag 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) (tag (make-from-real-imag x y)))) (put 'make-from-mag-ang 'polar (lambda (r a) (tag (make-from-mag-ang r a)))) 'done) (define (make-from-mag-ang r a) ((get 'make-from-mag-ang 'polar) r a))
apply-generic 函数:
(define (apply-generic op . args) (let ((type-tags (map type-tag args))) (let ((proc (get op type-tags))) (if proc (apply proc (map contents args)) (error "No method for these types -- APPLY-GENERIC" (list op type-tags))))))
magnitude 、 angle 等四个通用选择器:
(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))
复数包:
(define (install-complex-package) (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 (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)))) (define (tag z) (attach-tag 'complex z)) (put 'add '(complex complex) (lambda (z1 z2) (tag (add-complex z1 z2)))) (put 'sub '(complex complex) (lambda (z1 z2) (tag (sub-complex z1 z2)))) (put 'mul '(complex complex) (lambda (z1 z2) (tag (mul-complex z1 z2)))) (put 'div '(complex complex) (lambda (z1 z2) (tag (div-complex z1 z2)))) (put 'make-from-real-imag 'complex (lambda (x y) (tag (make-from-real-imag x y)))) (put 'make-from-mag-ang 'complex (lambda (x y) (tag (make-from-mag-ang x y)))) 'done) (define (make-complex-from-real-imag x y) ((get 'make-from-real-imag 'complex) x y)) (define (make-complex-from-mag-ang r a) ((get 'make-from-mag-ang 'complex) r a))
put 函数和 get 函数:
(define operation-table (make-table)) (define get (operation-table 'lookup-proc)) (define put (operation-table 'insert-proc!))
标识(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)))
(install-rectangular-package) (install-polar-package) (install-complex-package)
修改过的复数包:
(define (install-complex-package) (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 (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)))) (define (tag z) (attach-tag 'complex z)) (put 'add '(complex complex) (lambda (z1 z2) (tag (add-complex z1 z2)))) (put 'sub '(complex complex) (lambda (z1 z2) (tag (sub-complex z1 z2)))) (put 'mul '(complex complex) (lambda (z1 z2) (tag (mul-complex z1 z2)))) (put 'div '(complex complex) (lambda (z1 z2) (tag (div-complex z1 z2)))) (put 'make-from-real-imag 'complex (lambda (x y) (tag (make-from-real-imag x y)))) (put 'make-from-mag-ang 'complex (lambda (r a) (tag (make-from-mag-ang r a)))) (put 'real-part '(complex) real-part) (put 'imag-part '(complex) imag-part) (put 'magnitude '(complex) magnitude) (put 'angle '(complex) angle) 'done) (define (make-complex-from-real-imag x y) ((get 'make-from-real-imag 'complex) x y)) (define (make-complex-from-mag-ang r a) ((get 'make-from-mag-ang 'complex) r a))
练习2.78
这道题要求我们修改type-tag、contents和attach-tag的定义使我们的通用算术系统可以利用Scheme的内部类型系统。也就是说将一个数字传递给make-scheme-number后返回的是scheme-number . 1(此处传入的是1)。更改之后的则不需要scheme-number这一部分了。
(define (attach-tag type-tag contents) (if (number? contents) contents (cons type-tag contents))) (define (type-tag datum) (cond ((number? datum) ‘scheme-number) ((pair? datum) (car datum)) (else (error “Bad tagged datum – TYPE-TAG” datum)))) (define (contents datum) (cond ((number? datum) datum) ((pair? datum) (cdr datum)) (else (error “Bad tagged datum – CONTENT” datum)))
install-scheme-number-package相关代码在书中第129页代码,这里load一下即可。
(install-scheme-number-package) ;Value: done (define ten (make-scheme-number 10)) ;Value: ten ten ;Value: 10 (contents ten) ;Value: 10 (type-tag ten) ;Value: scheme-number (add ten ten) ;Value: 20
感谢访问,希望对您有所帮助。 欢迎关注或收藏、评论或点赞。
为使本文得到斧正和提问,转载请注明出处:
http://blog.csdn.net/nomasp
版权声明:本文为 NoMasp柯于旺 原创文章,未经许可严禁转载!欢迎访问我的博客:http://blog.csdn.net/nomasp
相关文章推荐
- 从源码安装Mysql/Percona 5.5
- Java 6 JVM参数选项大全(中文版)
- Varnish Install And Configure
- autoit 命令行参数说明
- 给IE加个参数 永远不怕IE主页被修改
- SQLServer APPLY表运算符使用介绍
- 写批处理必备的一些命令参数使用技巧
- 安装软件 Nullsoft Install System 2.27汉化版 下载
- ASP 调用带参数输出的COM接口
- PowerShell实现参数互斥示例
- C#从命令行读取参数的方法
- DIV+CSS经常用到的属性、参数及说明
- asp获取URL参数的几种方法分析总结[原创]_应用技巧_脚本之家
- C#读取命令行参数的方法
- sql server 2008中的apply运算符使用方法
- 关于C语言中参数的传值问题
- c# 方法可变数量的参数
- MySQL slave_net_timeout参数解决的一个集群问题案例
- php中define用法实例
- 用PHP连接MySQL代码的参数说明