sicp 2.3-2.5 习题
2.53
(a b c)
((george))
((y1 y2))
(y1 y2)
#f
#f
(red shoes blue socks)
2.54
(define (equal? list1 list2)
(cond ((or(null? list1)(null? list2)) (if (eq? list1 list2)
#t
#f))
((eq? (car list1)(car list2)) (equal? (cdr list1)
(cdr list2)))
(else #f)))
2.55
(car ''abracadabra)=(car (quote(quote abracadabra)))=quote
2.56
((exponentiation? exp)
(make-product (make-product (exponent exp)
(make-exponentiation (base exp)
(-(exponent exp)1)))
(deriv (base exp) var)))
(define (exponentiation? e)
(and (pair? e) (eq? (car e) '**)))
(define (base e)
(cadr e))
(define (exponent e)
(caddr e))
(define (make-exponentiation b e)
(cond ((= e 0) 1)
((= e 1) b)
(else (list '** b e))))
2.57
如果只修改augend、multiplicand函数
(define (augend e)
(let ((l (append (list(car e))(cddr e))))
(if (null? (cddr l))
(cadr l)
l)))
(define (multiplicand e)
(let ((l (append (list(car e))(cddr e))))
(if (null? (cddr l))
(cadr l)
l)))
结果如下：
> (deriv '(+ x x x x (** x 2)) 'x)
(+ 1 (+ 1 (+ 1 (+ 1 (* 2 x)))))
> (deriv '(* x y (+ x 3) z) 'x)
(+ (* x (* y z)) (* y (+ x 3) z))
输出不够简洁，为了消去括号，须修改make-sum、make-product函数
(define (condition a1 a2)
(cond ((and(number? a1)(eq? (car a2) '+))
(if(number? (cadr a2))
(append (list '+ (+ a1 (cadr a2))) (cddr a2))
(append (list '+ a1) (cdr a2))))
((and(number? a1)(not(eq? (car a2) '+)))
(list '+ a1 a2))
((and(not(number? a1))(eq? (car a2) '+))
(append (list '+) (cdr a2) (list a1)))
((and(not(number? a1))(not(eq? (car a2) '+)))
(list '+ a1 a2))))
(define (make-sum a1 a2)
(cond ((and(pair? a1)(pair? a2))
(if(eq? (car a2) '+)
(append (list '+ a1) (cdr a2))
(list '+ a1 a2)))
((and(not(pair? a1))(pair? a2))
(condition a1 a2))
((and(pair? a1)(not(pair? a2)))
(condition a2 a1))
((and(not(pair? a1))(not(pair? a2)))
(cond ((and(number? a1)(number? a2))
(+ a1 a2))
((and(number? a1)(not(number? a2)))
(list '+ a1 a2))
((and(not(number? a1))(number? a2))
(list '+ a2 a1))
(else (list '+ a1 a2))))))
加法和乘法相同
写的太繁琐了，应该可以改进 不想改了，继续前进
2.58
a
(define (sum? e)
(and (pair? e)(eq? (cadr e) '+)))
(define (addend e)
(car e))
(define (augend e)
(caddr e))
(define (make-sum a1 a2)
(cond ((=number? a1 0)a2)
((=number? a2 0)a1)
((and(number? a1)(number? a2))(+ a1 a2))
(else (list a1 '+ a2))))
(define (make-product m1 m2)
(cond ((or (=number? m1 0) (=number? m2 0)) 0)
((=number? m1 1) m2)
((=number? m2 1) m1)
((and (number? m1)(number? m2)) (* m1 m2))
(else (list m1 '* m2))))
(define (product? e)
(and (pair? e) (eq? (cadr e) '*)))
(define (multiplier e)
(car e))
(define (multiplicand e)
(caddr e))
(define (exponentiation? e)
(and (pair? e) (eq? (cadr e) '**)))
(define (base e)
(car e))
(define (exponent e)
(caddr e))
(define (make-exponentiation b e)
(cond ((= e 0) 1)
((= e 1) b)
(else (list b '** e))))
2.59
(define (union-set set1 set2)
(cond ((null? set1)set2)
((element-of-set? (car set1) set2)(union-set (cdr set1) set2))
(else (union-set (cdr set1) (adjoin-set (car set1) set2)))))
2.60
(define (element-of-set? x set)
(cond ((null? set) #f)
((equal? x (car set)) #t)
(else (element-of-set? x (cdr set)))))
(define (adjoin-set x set)
(cons x set))
(define (intersection-set set1 set2)
(cond ((or(null? set1)(null? set2)) '())
((element-of-set? (car set1) set2)(cons(car set1)
(intersection-set(cdr set1)
set2)))
(else (intersection-set (cdr set1) set2))))
(define (union-set set1 set2)
(append set1 set2))
喜欢前一个
2.61
(define (adjoin-set x set)
(cond ((null? set) (cons x set))
((< x (car set)) (cons x set))
((> x (car set)) (cons (car set) (adjoin-set x (cdr set))))
((= x (car set)) set)))
2.62
(define (union-set set1 set2)
(if(null? set1)
set2
(if(null? set2)
set1
(let ((x1 (car set1)) (x2 (car set2)))
(cond ((< x1 x2) (cons x1 (union-set (cdr set1) set2)))
((= x1 x2) (cons x1 (union-set (cdr set1) (cdr set2))))
((> x1 x2) (cons x2 (union-set set1 (cdr set2)))))))))
2.63
产生相同的序列
都是O(n)
2.64
找到中间的元素，左边为左子树，右边为右子树
递归生成左子树，右子树
时间复杂度O(n)
2.65
(define (union-set set1 set2)
(define (union set1 set2)
(if(null? set1)
set2
(if(null? set2)
set1
(let ((x1 (car set1)) (x2 (car set2)))
(cond ((< x1 x2) (cons x1 (union-set (cdr set1) set2)))
((= x1 x2) (cons x1 (union-set (cdr set1) (cdr set2))))
((> x1 x2) (cons x2 (union-set set1 (cdr set2)))))))))
(list-tree(union (tree-list set1) (tree-list set2))))
(define (intersection-set set1 set2)
(define (intersection set1 set2)
(if (or (null? set1)(null? set2))
'()
(let ((x1 (car set1))
(x2 (car set2)))
(cond ((= x1 x2) (cons x1 (intersection (cdr set1)(cdr set2))))
((< x1 x2) (intersection (cdr set1) set2))
((> x1 x2) (intersection set1 (cdr set2)))
(else (intersection-set (cdr set1)set2))))))
(list-tree (intersection (tree-list set1) (tree-list set2))))
2.66
(define (lookup given-key set-of-records)
(cond ((null? set-of-records) #f)
((equal? given-key (key (entry set-of-records)))
(entry set-of-records))
((< given-key (key (entry set-of-records)))
(lookup given-key (left-branch set-of-records)))
(else (lookup given-key (right-branch set-of-records)))))
2.67
> (decode sample-message sample-tree)
(A D A B B C A)
2.68
(define (encode message tree)
(if (null? message)
'()
(append (encode-symbol (car message) tree)
(encode (cdr message) tree))))
(define (encode-symbol letter tree)
(if(leaf? tree)
'()
(cond((member? letter(symbols(left-branch tree)))
(cons 0 (encode-symbol letter (left-branch tree))))
((member? letter(symbols(right-branch tree)))
(cons 1 (encode-symbol letter (right-branch tree))))
(else (error "Do not exist")))))
(define (member? a b)
(cond ((null? b) #f)
((eq? a (car b)) #t)
(else (member? a (cdr b)))))
2.69
(define (successive-merge set)
(if(null? (cdr set))
(car set)
(successive-merge (adjoin-set (make-code-tree (car set)
(cadr set))
(cddr set)))))
2.70
1 1 1 1 1 1 1 0 0 1 1 1 1 0 1 1 1 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 0 0 1 1 1 1 0 1 1 1 0 0 0 0 0 0 0 0 0 1 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 1 1 0 1 1 0 1 1
用固定长度编码每个单元3位
2.71
最常用的1位，最不常用的n-1位
2.72
时间复杂度 best case O(n) worst case O(n^2)
2.73
a
建表，以后无需修改源程序就可以添加项目
number？呵same-variable?无标识符来识别
b
(define (install-sum-package)
(define (deriv-sum exp var)
(make-sum (deriv (addend exp) var)
(deriv (augend exp) var)))
(put 'deriv '(sum) deriv-sum)
'done)
(define (install-product-package)
(define (deriv-product exp var)
(make-sum (make-product (deriv (multiplier exp) var)
(multiplicand exp))
(make-product (multiplier exp)
(deriv (multiplicand exp) var))))
(put 'deriv '(product) deriv-product))
c
(define (install-exponentiation-package)
(define (deriv-exponentiation exp var)
(let ((e (exponent exp))
(b (base exp)))
(make-product e
(make-product (make-exponentiation b
(- e 1))
(deriv b var)))))
(put 'deriv '(exponentiation) deriv-exponentiation))
d
无需改变
2.75
(define (make-from-mag-ang r a)
(define (dispatch op)
(cond ((eq? op 'magnitute) r)
((eq? op 'angle) a)
((eq? op 'real-part) (* r (cos a)))
((eq? op 'imag-part) (* r (sin a)))
(else (error "unknown op"))))
dispatch)
2.77
加入下列语句后我们便可以进行
例如(complex rectangular 3 4)
当((apply-generic 'magnitute 'complex)(complex rectangular 3 4))时，便执行real-part函数((apply-generic 'magnitute 'rectangular)(rectangular 3 4))
最后执行(magnitute (3 4)=5
apply-generic一共执行2次。
2.78
(define (attach-tag type-tag contents)
(if (number? contents)
contents
(cons type-tag contents)))
(define (type-tag contents)
(cond((number? datum)'scheme-number)
((pair? datum)(car datum))
(else (error "Bad tagged datum" datum))))
(define (contents datum)
(cond((pair? datum)(cdr datum))
((number? datum)datum)
(else (error "Bad tagged datum" datum))))
2.79
(define (equ? x y)
(apply-generic 'equ x y))
(put 'equ? '(scheme scheme) =)
(put 'equ? '(rational rational) (lambda(x y)(and(=(numer x)(numer y))
(=(denom x)(denom y)))))
(put 'equ? '(complex complex)(lambda(z1 z2)(and(=(magnitute z1)(magnitute z2))
(=(angle z1)(angle z2)))))
2.80
(define (=zero? x)
(apply-generic '=zero? x))
(put '=zero? 'scheme (lambda(x)(= x 0)))
(put '=zero? 'rational (lambda(x)(= (numer x) 0)))
(put '=zero? 'complex (lambda(x)(and(= (real-part x) 0)
(= (imag-part x) 0))))
coercion 类型强制转换。为了能让两个不同的类型进行计算，我们应该怎么做呢？
是给这些对象分别写一个程序，还是其他？ 类型转换跟类型的操作无关，只跟自身有关。
2.81
a
无限递归
b
wrong
c
(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))
(if (= (length args) 2)
(let ((type1 (car type-tags))
(type2 (cadr type-tags))
(a1 (car args))
(a2 (cadr args)))
(if(eq? type1 type2)
(error "no")
(let ((t1->t2 (get-coercion type1 type2))
(t2->t1 (get-coercion type2 type1)))
(cond (t1->t2 (apply-generic op (t1->t2 a1) a2))
(t2->t1 (apply-generic op a1 (t2->t1 a2)))
(else (error "No"))))))
(error "no"))))))
后面的十几道题目不做了
做这些异常抽象的题目真是烦人，没有输出结果
