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"))))))
後面的十幾道題目不做了
做這些異常抽象的題目真是煩人，沒有輸出結果