; it's like merge sort's "merge" step
; it's theta(n) where n is the total size of set1 and set2
(define (union-set set1 set2)
(cond ((empty? set1) set2)
((empty? set2) set1)
(else
(let ((x1 (car set1)) (x2 (car set2)))
(cond ((= x1 x2) (cons x1 (union-set (cdr set1) (cdr set2))))
((< x1 x2) (cons x1 (union-set (cdr set1) set2)))
((> x1 x2) (cons x2 (union-set set1 (cdr set2))))
(else (error "What the hell!? x1=" x1 " x2=" x2)))))))
(define (adjoin-set x set)
(if (empty? set)
(list x)
(let ((head (car set)))
(cond ((= x head) set)
((> x head) (cons x set))
((< x head) (cons head (adjoin-set x (cdr set))))
(else (error "What the hell!? x=" x))))))
; element-of-set? remains the same
; it's still theta(n), but since duplicate ones are normally larger
; than non-duplicate ones, it can still be slower
; adjoin-set can be much simpler since we don't mind duplicates
; it's theta(1), i.e., constant time
(define (adjoin-set x set)
(cons x set))
; intersection-set can also remain the same...the same theta(n^2), too
; union-set can be simpler, too
; it's theta(n), where n is the size of set1
(define (union-set set1 set2)
(cond ((null? set1) set2)
((null? set2) set1)
(else (cons (car set1) (union-set (cdr set1) set2)))))
(define (union-set set1 set2)
(cond ((null? set1) set2)
((null? set2) set1)
((element-of-set? (car set1) set2)
(union-set (cdr set1) set2))
(else (cons (car set1) (union-set (cdr set1) set2)))))
这题比较麻烦一点我大概讲一下思路。因为我们设计了data
abstraction,所以只需要改动predicates/selectors/constructors就行了。a很好办,“运算符号的位置变了
”,影响其实很小。只是运算符简单的变了个位置,但变后位置依然固定,且它们依然可以作为判断依据,所以那哥儿仨很容易就可以改写正确。b虽然也是这个思
路,但问题在于这个信息变复杂了。b中每个式子的元素不是正好三个了,而且无法简单的通过运算符来判断是sum还是product。比如a*b+c这个式
子,人类知道这是个sum因为人类懂precedence。机器在这里需要把这个因素考虑进去。
我看到其他人的解决方案貌似都是写
recursive descent
parser...我觉着没这么麻烦吧。。。又不是考编译原理,我不想把问题复杂化,于是只依题意考虑sum和product。也就是说如果式子里有+就
肯定是sum,如果有*而没有+,那肯定是product。
(define (augend l)
(let ((body (cddr l)))
(if (and (pair? body) (= 1 (length body)))
(car body)
(cons '+ body))))
; difference
(define (make-difference a1 a2)
(cond ((=number? a2 0) a1)
((and (number? a1) (number? a2)) (- a1 a2))
(else (list '- a1 a2))))
; exponentiation
(define (make-exponentiation base exponent)
(cond ((and (number? exponent) (= exponent 0)) 1)
((and (number? exponent) (= exponent 1)) base)
(else
(list '** base exponent))))
(define (exponentiation? x)
(and (pair? x) (eq? (car x) '**)))
(define base cadr)
(define exponent caddr)
; deriv
(define (deriv exp var)
(cond ((number? exp) 0)
((variable? exp)
(if (same-variable? exp var) 1 0))
((sum? exp)
(make-sum (deriv (addend exp) var)
(deriv (augend exp) var)))
((product? exp)
(make-sum
(make-product (multiplier exp)
(deriv (multiplicand exp) var))
(make-product (deriv (multiplier exp) var)
(multiplicand exp))))
((exponentiation? exp)
(let ((e (exponent exp)) (b (base exp)))
(make-product
e
(make-product
(make-exponentiation b (make-difference e 1))
(deriv b var)))))
(else
(error "unknown expression type -- DERIV" exp))))
(car (quote (quote abracadabra)))
经过一次eval后,car看到的参数是(quote abracadabra)。
换了PLT 4.1,equal?这个名字会引发重定义错误,应该是R6RS带来的,原来不这样。遂使用e?。
(define (e? l1 l2)
(cond
((and (symbol? l1) (symbol? l2)) (eq? l1 l2))
((and (list? l1) (list? l2))
(cond
((or (and (not (empty? l1)) (empty? l2)) (and (empty? l1) (not (empty? l2)))) #F)
((and (empty? l1) (empty? l2)) #T)
((and (e? (car l1) (car l2)) (e? (cdr l1) (cdr l2))) #T)
(else #F)))
(else #F)))
在babelnova.net上看到的版本:
(define (equal? a b)
(cond
((and (pair? a)
(pair? b))
(and (equal? (car a) (car b))
(equal? (cdr a) (cdr b))))
((eq? a b) #t)
(else #f)
)
)
此版本虽然运行正确,但违背了题中假设eq?仅能判断symbol相等性。运行过程中eq?会去判断list是否相等。
(a b c)
((george))
((y1 y2))
(y1 y2)
#F
#F
(red shoes blue socks)
图像语言这一节很值得思考。有这几个元素需要关注:
frame(框架):决定了图像的位置、大小和形状。由三个向量表示:1,frame原点相对于坐标原点(即屏幕画布原点)的位置;2,frame原点所在边1的另一端点,相对于frame原点的位置;3,frame原点所在边2的另一端点,相对于frame原点的位置。frame必是平行四边形,因此才可以这样表示(而不需要定义frame原点的对角点)。注意用来表示frame的点,都是基于真实坐标的。
painter(画家 ):接受一个frame为参数,在frame指定区域内画出具有符合frame位置,形状及大小的图像。不同的painter画不同的图像。因此painter自身需要储存“画什么”这个信息(使用基于单位正方形的坐标来表示)。由于要调用图像库画东西,painter必须知道“真实的”坐标才能画。但frame是临时传进来的,因此绘图的位置,大小和形状都需要临时计算。这时要使用frame-coord-map,把基于单位正方形的坐标,根据frame,变换到真是坐标。就好像painter里有一个底片,现在要根据相框的大小形状进行映射一样。
operation(操作):接受一个或多个painter为参数,返回一个painter。常用来组合简单painter以形成复杂painter。注意operation是定义在painter闭包上的运算(此闭包是真正数学意义上的闭包。。。不是函数+自由变量那个),这意味着painter可以被无限组合。
higher-order operation(高阶操作):接受一个或多个operation为参数,返回新的operation。定义在operation闭包上的运算。
最后奉上可以直接运行看效果的代码:
2.49 2.50 2.51 2.52
老潘也来画一把:

; same as 2.2
(define (make-segment start end)
(cons start end))
;or (define make-segment cons)
(define (start-segment seg)
(car seg))
;or (define start-segment car)
(define (end-segment seg)
(cdr seg))
;or (define end-segment cdr)
(define (origin-frame frame)
(car frame))
; or (define origin-frame car)
(define (edge1-frame frame)
(cadr frame))
; or (define edge1-frame cadr)
(define (edge2-frame frame)
(caddr frame))
; or (define edge2-frame caddr)
(define (origin-frame frame)
(car frame))
; or (define origin-frame car)
(define (edge1-frame frame)
(cadr frame))
; or (define origin-frame cadr)
(define (edge2-frame frame)
(cddr frame))
; or (define origin-frame cddr)
(define (make-vect x y)
(cons x y))
; or (define make-vect cons)
(define (xcor-vect v)
(car v))
; or (define xcor-vect car)
(define (ycor-vect v)
(cdr v))
; or (define ycor-vect cdr)
(define (add-vect v1 v2)
(make-vect
(+ (xcor-vect v1) (xcor-vect v2))
(+ (ycor-vect v1) (ycor-vect v2))))
(define (sub-vect v1 v2)
(make-vect
(- (xcor-vect v1) (xcor-vect v2))
(- (ycor-vect v1) (ycor-vect v2))))
(define (scale-vect s v)
(make-vect
(* s (xcor-vect v))
(* s (ycor-vect v))))
两个解法。注意lambda那个是如何等价于define的,尽管我们更习惯于define那个。
(define (split op1 op2)
(define (op painter n)
(if (= n 0)
painter
(let ((smaller (op painter (- n 1))))
(op1 painter (op2 smaller smaller)))))
op)
(define (split op1 op2)
(lambda (painter n)
(if (= n 0)
painter
(let ((smaller ((split op1 op2) painter (- n 1))))
(op1 painter (op2 smaller smaller))))))