《SICP》習題第2章

本人做的SICP習題第2章，如有錯誤請指正，用的解釋器是Racket

練習2.1

;; Exercise 2.1
;; 有理數
#lang racket

;; 有理數定義
(define (numer x) (car x))
(define (demon x) (cdr x))
;; 處理分子分母均爲正的有理數
(define (make-positive-rat n d)
  (let ((g (gcd n d)))
    (cons (/ n g) (/ d g))))
;; 處理正負有理數
(define (make-rat n d)
  (define positive-rat (make-positive-rat (abs n) (abs d)))
  (if (< (* n d) 0)
      (cons (- (numer positive-rat)) (demon positive-rat))
      positive-rat))

練習2.2

point相關的代碼

;; Exercise 2.2
;; point
#lang racket
(provide (all-defined-out))

;; selector
(define (x-point x) (car x))
(define (y-point x) (cdr x))

;; make
(define (make-point x y) (cons x y))

;; print
(define (print-point p)
  (newline)
  (display "(")
  (display (x-point p))
  (display ",")
  (display (y-point p))
  (display ")"))

segment相關

;; Exercise 2.2
;; segment
#lang racket
(require "point.rkt")
(provide (all-defined-out))

;; selector
(define (start-segment x) (car x))
(define (end-segment x) (cdr x))

;; make
(define (make-segment start end)
  (cons start end))

;; 平均數
(define (avg x y)
  (/ (+ x y) 2.0))

;; 求中點
(define (midpoint-segment s)
  (make-point (avg (x-point (start-segment s)) (x-point (end-segment s))) (avg (y-point(start-segment s)) (y-point (end-segment s)))))

練習2.3

看起來題目是想讓我們用多種不同的底層方法實現矩形，然後計算周長和麪積的函數不論底層實現怎麼樣都可以用

先寫周長和麪積函數

;; Exercise 2.3
;; 矩形的相關計算
#lang racket
(require "rectangle-by-segment.rkt")
(provide (all-defined-out))

;; 計算周長
(define (perimeter rectangle)
  (* 2 (+ (width rectangle) (height rectangle))))

;; 計算面積
(define (area rectangle)
  (* (width rectangle) (height rectangle)))

第一種實現方法，用兩根線定義矩形，爲了方便計算長寬，修改練習2.2中的segment，增加一個函數計算線段的長度

;; 求線段長度
(define (length s)
  (sqrt (+ (square (- (x-point (start-segment s)) (x-point (end-segment s))))
           (square (- (y-point (start-segment s)) (y-point (end-segment s)))))))

現在實現矩形

;; Exercise 2.3
;; 通過寬和高定義矩形
#lang racket
(provide (all-defined-out))
(require "segment.rkt")

;; make
(define (make-rectangle s1 s2) (cons s1 s2))

;; selector
(define (width r)
  (length (car r)))
(define (height r)
  (length (cdr r)))

第二種方法，用四個點實現矩形，其實三個點就可以定義一個矩形，爲了方便還規定了四個點必須按順時針順序輸入（不然還要判斷哪兩個點在對角線上，麻煩）

;; Exercise 2.3
;; 通過4個點定義矩形
#lang racket
(require "point.rkt")
(require "segment.rkt")
(provide (all-defined-out))

;; make
(define (make-rectangle p1 p2 p3 p4)
  (cons (cons p1 p2) (cons p3 p4)))

;; selector
(define (width r)
  (length (make-segment (car (car r)) (cdr (car r)))))
(define (height r)
  (length (make-segment (cdr (car r)) (cdr (cdr r)))))

最後來寫一個測試方法，測試兩種矩形實現方式

;; Exercise 2.3
;; 矩形測試
#lang racket
(require "point.rkt")
(require "segment.rkt")
(require "rectangle-calculate.rkt")
;; 可以替換矩形底層實現
(require "rectangle-by-point.rkt")
;; (require "rectangle-by-segment.rkt")

;; 定義四個點
(define p1 (make-point 3 4))
(define p2 (make-point 5 6))
(define p3 (make-point 7 4))
(define p4 (make-point 5 2))

;; 定義兩條邊
(define s1 (make-segment p1 p2))
(define s2 (make-segment p2 p3))

;; 定義矩形
(define r (make-rectangle p1 p2 p3 p4))
;; (define r (make-rectangle s1 s2))

;; 計算周長和麪積
(perimeter r)
(area r)

練習2.4

;; Exercise 2.4
;; cons的另一種定義方法
#lang racket

;; cons
(define (cons x y)
  (lambda (m) (m x y)))

;; selector
(define (car z)
  (z (lambda (p q) p)))
(define (cdr z)
  (z (lambda (p q) q)))

這段代碼，(car (cons x y))可以替換爲((lambda (m) (m x y)) (lambda (p q) p))

進一步替換爲((lambda (p q) p) x y)

所以(car (cons x y))可以返回x

其實cons就是返回一個匿名函數，這個匿名函數接收一個函數，並將x、y作爲參數輸入給這個函數

練習2.5

;; Exercise 2.5
;; 用2^a3^b這個整數，記錄a、b
#lang racket

;; cons
(define (cons a b)
  (* (expt 2 a) (expt 3 b)))

;; 判斷是否爲偶數
(define (even? x)
  (=  (remainder x 2) 0))

;; 獲取x中因子a的個數
(define (get-factor-num x a)
  (define (iter n r)
    (if (= (remainder r a) 0)
        (iter (+ n 1) (/ r a))
        n))
  (iter 0 x))
      
;; selector
(define (car c)
  (get-factor-num c 2))
(define (cdr c)
  (get-factor-num c 3))

練習2.6

這道題的題幹初看有點懵逼的，我個人膚淺的理解寫在了這裏SICP習題2.6 題目理解

求1，1就是(add-1 zero)，2就是(add-1 one)，以此類推，答案在下面，展開就是了

;; Exercise 2.6
;; 丘奇數
#lang racket

;; 0
(define zero (lambda (f) (lambda (x) x)))

;; 加1
(define (add-1 n)
  (lambda (f) (lambda (x) (f ((n f) x)))))

;; 1
(define one
  (lambda (f) (lambda (x) (f x))))

;; 2
(define two
  (lambda (f) (lambda (x) (f (f x)))))

總結一下，丘奇數，就是f(f(f(...x)))中，調用f的次數來表示對應的數的

仔細看一下丘奇數的函數，(丘奇數 f)這個調用所返回的函數就是給輸入套上多層f的外殼，丘奇數對應幾就套幾個f殼

所以加法就是一個套殼的操作，兩個輸入是m和n（注意是丘奇數不是阿拉伯數字），先套n個殼，再套m個殼，就是加法了

;; 加
(define (add m n)
  (lambda (f)
    (lambda (x)
      ((m f) ((n f) x)))))

練習2.7

超簡單

;; Exercise 2.7
;; 區間計算
#lang racket

;; make
(define (make-interval a b) (cons a b))

;; selector
(define (lower-bound i)
  (car i))
(define (upper-bound i)
  (cdr i))

練習2.8

;; 減
(define (sub-interval x y)
  (make-interval (- (lower-bound x) (upper-bound y))
                 (- (upper-bound y) (lower-bound y))))

練習2.9

假設區間和

對於加法，

區間的寬度爲 $\frac{x_2+y_2-x_1-y_1}{2} = \frac{x_2-x_1}{2}+\frac{y_2-y_1}{2}$ ，等於原區間寬度之和

對於減法，

區間的寬度爲 $\frac{x_2-y_2-x_1+y_1}{2} = \frac{x_2-x_1}{2}-\frac{y_2-y_1}{2}$ ，等於原區間寬度之差

對於乘法，假設有區間和，相乘得到，寬度爲5，原寬度是1和3，並不等於原區間寬度的積

對於除法，假設有區間和，相除得到，寬度爲5.5，原寬度是1和3，並不等於原區間寬度的商

練習2.10

;; 除
(define (div-interval x y)
  (if (span-zero? y)
      (error "the interval spans zero")
      (mul-interval x 
                    (make-interval (/ 1.0 (upper-bound y))
                                   (/ 1.0 (lower-bound y))))))

;; 檢測區間是否跨過0，包含端點在0的情況
(define (span-zero? i)
  (and (<= (lower-bound i) 0) (>= (upper-bound i) 0)))

;; 檢測區間是否跨過0，包含端點在0的情況
(define (span-zero? i)
  (and (<= (lower-bound i) 0) (>= (upper-bound i) 0)))

練習2.11

一個區間有9種情況，在0的左側，在0的右側，橫跨0

因此兩個區間就有9種情況，列個表，假設區間和，區間在0左側就用<0表示，在0右側表示爲>0

分佈情況	乘法
x>0,y>0
x>0,y=0
x>0,y<0
x=0,y>0
x=0,y=0
x=0,y<0
x<0,y>0
x<0,y=0
x<0,y<0

代碼如下

;; 判斷區間是否在0右側
(define (right-zero? i)
  (and (> (lower-bound i) 0) (> (upper-bound i) 0)))

;; 乘
(define (mul-interval x y)
  (let ((p1 (* (lower-bound x) (lower-bound y)))
        (p2 (* (lower-bound x) (upper-bound y)))
        (p3 (* (upper-bound x) (lower-bound y)))
        (p4 (* (upper-bound x) (upper-bound y))))
    (cond ((right-zero? x)
           (cond ((right-zero? y) (make-interval p1 p4))
                 ((span-zero? y)  (make-interval p3 p4))
                 (else (make-interval p3 p2))))
          ((span-zero? x)
           (cond ((right-zero? y) (make-interval p2 p4))
                 ((span-zero? y)  (make-interval (min p2 p3) (max p1 p4)))
                 (else (make-interval p3 p1))))
          (else
           (cond ((right-zero? y) (make-interval p2 p3))
                 ((span-zero? y)  (make-interval p2 p1))
                 (else (make-interval p4 p1)))))))

練習2.12

;; 百分比表示，make
(define (make-center-percent c p)
  (make-interval (- c (* c p)) (+ c (* c p))))

;; 百分比表示，selector
(define (center i)
  (/ (+ (lower-bound i) (upper-bound i)) 2))
(define (percent i)
  (/ (- (upper-bound i) (center i)) (center i)))

練習2.13

假設兩個區間， $x_c\pm x_cx_p$ 和 $y_c\pm y_cy_p$ ，相乘得到的區間爲

用百分比來表達，中心點爲，誤差百分比是是 $\frac{x_p+y_p}{1+x_py_p}$

練習2.14

現有的代碼，A/A得不到[1,1]

練習2.15

par2可以得到正確的結果，par1是錯誤的

舉個例子，兩個電阻的阻值範圍[2,3],[4,5]

par1計算的分子是[6,8]，分母是[8,15]

除出來是[0.6000000000000001,1.0]，是錯誤的，因爲分子的最大值，8，是阻值取3和5的結果，而分母的最小值8，是阻值取2和4的結果

雖然電阻存在誤差，但是一個電阻的阻值是不會變的，所以par1計算的是不可能存在的結果

學術一點來說，就是每個區間之間是獨立的，但是出現在一個公式裏的相同區間不是獨立的，而我們程序考慮的都是每個輸入區間完全獨立的情況

如果每個區間只在計算中出現一次，就避免了這種情景，所以Eva Lu Ator說的是對的

練習2.16

思考了一下，區間運算，本質就是一個熟悉的數學問題，給出一個函數和多個自變量的範圍，求函數的取值範圍

如果自變量只有一個，很好做，初中都學過，如果自變量有多個呢，駐點、求偏導等一系列操作

首先，要寫出正確的程序，我們必須時刻關注，出現一次以上的區間的相關性，需要把相同的區間區分開來

其次，要求偏導，求駐點，求偏導需要符號計算，求駐點需要解方程……

我感覺我這個水平做不到

練習2.17

;; Exercise 2.17
;; list
#lang racket

;; 返回list最後一個元素
(define (last-pair l)
  (if (null? (cdr l))
      (car l)
      (last-pair (cdr l))))

練習2.18

;; 反轉list
(define (reverse l)
  (define (reverse-iter remain result)
    (if (null? remain)
        result
        (reverse-iter (cdr remain) (cons (car remain) result))))
  (reverse-iter l null))

練習2.19

;; Exercise 2.19
;; 使用list重寫count-change
#lang racket

;; 硬幣大小
(define us-coins (list 50 25 10 5 1))
(define uk-coins (list 100 50 20 10 5 2 1 0.5))

;; 計算找零方式
(define (cc amount coin-values)
  (cond ((= amount 0) 1)
        ((or (< amount 0) (no-more? coin-values)) 0)
        (else
         (+ (cc amount
                (except-first-denomination coin-values))
            (cc (- amount
                   (first-denomination coin-values))
                coin-values)))))

;; 判斷是否沒有其餘硬幣作爲選擇
(define (no-more? coin-values)
  (null? coin-values))

;; 放棄使用當前硬幣
(define (except-first-denomination coin-values)
  (cdr coin-values))

;; 獲取當前硬幣價值
(define (first-denomination coin-values)
  (car coin-values))

練習2.20

構建一個新的list，把符合條件的元素加到list裏，最後反轉整個list得到

;; Exercise 2.20
;; 返回與第一個元素奇偶性一致的元素
#lang racket
(require "list.rkt")

;; 判斷奇偶性一致
(define (same? x y)
  (= (remainder x 2) (remainder y 2)))

;; 過濾
(define (same-parity x . l)
  (define (same-parity-iter remain result)
    (if (null? remain)
        (cons x (reverse result))
        (if (same? x (car remain))
            (same-parity-iter (cdr remain) (cons (car remain) result))
            (same-parity-iter (cdr remain) result))))
  (same-parity-iter l null))

練習2.21

;; 對隊列中的每個數取平方，遞歸版
(define (square-list-recursive items)
  (if (null? items)
      null
      (cons (* (car items) (car items)) (square-list-recursive (cdr items)))))

;; 對隊列中的每個數取平方，map版
(define (square-list-map items)
  (map (lambda(x) (* x x)) items))

練習2.22

越先和result進行cons操作的元素，越排在列表的後面

迭代的時候是從頭到尾迭代的，所以最後的結果是反的

第二段代碼是錯誤的，假設一個list是(1,2,3,4,5)

第一次迭代時，調用了(iter (1,2,3,4,5) nil)，最後執行了(cons null 1)

第二次迭代時，調用了(iter (2,3,4,5) (cons null 1)，最後執行了(cons (cons null 1) 4))

所以這段代碼調用的結果是(((((() . 1) . 4) . 9) . 16) . 25)，這個結構不是list，是list結構的顛倒，如果把car和cdr調換一下，本質上還是一個(25,16,9,4,1)

練習2.23

;; Exercise 2.23
;; for循環
#lang racket

;; 對l中的每個元素執行f
(define (for-each f l)
  (cond ((not (null? l))
         (f (car l))
         (for-each f (cdr l)))))

練習2.24

eval之後是(1 (2 (3 4)))

練習2.25

比較難的就是第三個，對l3執行一次cdr之後得到的是一個list，但不是直接(2,3,4,5,6,7)，而是一個((2,3,4,5,6,7), null)，所以要一個car取出list

;; Exercise 2.25
;; 獲取list中的7
#lang racket

(define l1 (list 1 3 (list 5 7) 9))
(define l2 (list (list 7)))
(define l3 (list 1 (list 2 (list 3 (list 4 (list 5 (list 6 7)))))))

;; 獲取7
(car (cdr (car (cdr (cdr l1)))))
(car (car l2))
(car (cdr (car (cdr (car (cdr (car (cdr (car (cdr (car (cdr l3))))))))))))

練習2.26

答案分別是：

(1 2 3 4 5 6)
((1 2 3) 4 5 6)
((1 2 3) (4 5 6))

這一章一直很疑惑，爲什麼(cons (list 1 2) (list 3 4))是((1 2) 3 4)

展開一下list，是(cons 1 (cons 2 nil))和(cons 3 (cons 4 nil))

所以展開(cons (list 1 2) (list 3 4))

(cons (cons 1 (cons 2 nil)) (cons 3 (cons 4 nil)))，打印出來是((1 2) 3 4)，從展開式可以看出來這是一個3元素的list，第1個元素是list，後兩個元素是數字，因爲缺少了一個nil

再展開一下(list (list 1 2) (list 3 4))

(cons (cons 1 (cons 2 nil)) (cons (cons 3 (cons 4 nil)) nil))，打印出來是((1 2) (3 4))，從展開式可以看出來這是一個2元素的list，每個元素都是一個list

練習2.27

;; Exercise 2.27
;; 深度翻轉list
#lang racket

;; 深度翻轉list
(define (deep-reverse l)
  (define (iter remain result)
    (if (null? remain)
        result
        (iter (cdr remain) (cons (deep-reverse (car remain)) result))))
  (if (pair? l)
      (iter l null)
      l))

練習2.28

;; Exercise 2.28
;; 從左到右，返回一棵樹的所有葉節點
#lang racket

;; 返回葉節點
(define (fringe tree)
  (cond ((null? tree) null)
        ((pair? tree) (append (fringe (car tree)) (fringe (cdr tree))))
        (else (list tree))))

練習2.29

;; mobile selector
(define (left-branch m)
  (car m))
(define (right-branch m)
  (car (cdr m)))

;; branch selector
(define (branch-length m)
  (car m))
(define (branch-structure m)
  (car (cdr m)))

;; 判斷branch是否包含mobile
(define (branch-contains-mobile b)
  (pair? (branch-structure b)))

;; 判斷branch的總重
(define (total-weight-branch b)
  (cond ((null? b) 0)
        ((branch-contains-mobile b) (total-weight (branch-structure b)))
        (else (branch-structure b))))

;; mobile的總重
(define (total-weight m)
  (cond ((null? m) 0)
        ((pair? m) (+ (total-weight-branch (left-branch m))
                      (total-weight-branch (right-branch m))))
        (else m)))

;; 計算branch產生的力矩
(define (torque b)
  (* (branch-length b) (total-weight-branch b)))

;; 判斷branch是否平衡
(define (balance-branch b)
  (if (branch-contains-mobile b)
      (balance (branch-structure b))
      true))

;; 判斷mobile是否平衡
(define (balance m)
  (if (null? m)
      true
      (and (= (torque (left-branch m)) (torque (right-branch m)))
           (balance-branch (left-branch m))
           (balance-branch (right-branch m)))))

只需要修改selector即可

;; Exercise 2.29
;; 用cons構造mobile
#lang racket

;; make mobile
(define (make-mobile left right)
  (cons left right))

;; make branch
(define (make-branch length structure)
  (cons length structure))

;; mobile selector
(define (left-branch m)
  (car m))
(define (right-branch m)
  (cdr m))

練習2.30

;; Exercise 2.39
;; 對樹裏的所有元素取平方
#lang racket

;; 對樹裏所有元素取平方
(define (square-tree t)
  (cond ((null? t) null)
        ((pair? t) (cons (square-tree (car t)) (square-tree (cdr t))))
        (else (square t))))

;; 平方
(define (square x)
  (* x x))

練習2.31

;; Exercise 2.31
;; 對樹裏的所有元素採取某種操作
#lang racket

;; map
(define (tree-map proc t)
  (cond ((null? t) null)
        ((pair? t) (cons (tree-map proc (car t)) (tree-map proc (cdr t))))
        (else (proc t))))

(define t
  (list 1
       (list 2 (list 3 4) 5)
       (list 6 7)))

(tree-map (lambda (x) (* x x)) t)

練習2.32

把一個集合分成兩部分，首元素和其餘部分，那麼這個集合的所有子集，也可以分爲兩個部分

一個部分是其餘部分的子集，另一個部分是其餘部分的子集再加上首元素

以(1 2 3)爲例，分爲1和(2 3)，其子集分爲兩個部分

(2 3)的子集() (3) (2) (2 3)

和(2 3)子集併入首元素1，(1) (1 3) (1 2) (1 2 3)

;; Exercise 2.32
;; 生成一個list的所有子list
#lang racket

;; 子list生成
(define (subsets s)
  (if (null? s)
      (list null)
      (let ((rest (subsets (cdr s))))
        (append rest (map (lambda (l) (cons (car s) l)) rest)))))

練習2.33

;; map-by-accumulate
(define (map-by-accumulate p sequence)
  (accumulate (lambda (x y) (cons (p x) y)) null sequence))

;; append-by-accumulate
(define (append-by-accumulate seq1 seq2)
  (accumulate cons seq2 seq1))

;; length-by-accumulate
(define (length-by-accumulate sequence)
  (accumulate (lambda(x y) (+ y 1)) 0 sequence))

練習2.34

;; polynomial-by-accumulate
(define (horner-eval x coefficient-sequence)
  (accumulate (lambda (this-coeff higher-terms) (+
                                                  (* higher-terms x)
                                                  this-coeff))
               0
               coefficient-sequence))

練習2.35

首先使用map函數處理tree，tree是一個嵌套的list，用map函數把每個嵌套的子樹映射爲子樹葉節點數量

map函數裏遞歸調用了count-leaves來處理子樹

;; count-leaves-by-accumulate
(define (count-leaves t)
  (accumulate +
              0
              (map (lambda(x)
                     (cond ((null? x) 0)
                           ((pair? x) (count-leaves x))
                           (else 1)))
                   t)))

練習2.36

加入輸入的list都是3元素的，就先把所有隊列第一個元素提取出來，計算，然後和剩餘的（剩下的2元素）做cons

這裏有一個小問題，爲什麼一開始判斷null用的是(car seqs)而不是seqs

因爲到最後seqs是(() ())，這種list不是空的，所以要用(car seqs)判斷

;; 若干個list的對應位累計
(define (accumulate-n op initial seqs)
  (if (null? (car seqs))
      null
      (cons (accumulate op initial (map (lambda(x)
                                          (car x))
                                        seqs))
            (accumulate-n op initial (map (lambda(x)
                                            (cdr x))
                                          seqs)))))

練習2.37

;; 矩陣向量乘
(define (matrix-*-vector m v)
  (map (lambda (x) (dot-product x v)) m))

;; 矩陣轉置
(define (transpose mat)
  (accumulate-n cons null mat))

;; 矩陣乘矩陣
(define (matrix-*-matrix m n)
  (let ((cols (transpose n)))
    (map (lambda(x) (matrix-*-vector cols x)) m)))

練習2.38

第一組，答案分別是3/2和1/6

fold-right，也就是accumulate，看一下展開的過程，是1/(2/(3/1))

fold-left，展開是1/1/2/3

第二組，答案分別是list (1 list (2 list (3 (nil))))和(list (list (list nil 1) 2) 3)

跟上面類似，不展開了

跟執行順序無關的符號，滿足結合律，即算子（參數）位置沒有改變，運算順序（用括號改變）不會對結果有影響

比如加法，就可以在fold-right和fold-left取得相同結果

練習2.39

fold-right，利用append

;; 翻轉
(define (reverse sequence)
  (fold-right (lambda(x y)
                (append y (list x)))
              null
              sequence))

fold-left的很好寫

;; 翻轉
(define (reverse sequence)
  (fold-left (lambda(x y) (cons y x)) null sequence))

練習2.40

;; 生成整數對，並過濾和不爲質數的部分
(define (prime-sum-pairs n)
  (map make-pair-sum
       (filter prime-sum? (unique-pairs n))))

;; 產生1<= j< i<= n的整數對
(define (unique-pairs n)
  (flatmap
   (lambda (i)
     (map (lambda(j) (list i j))
          (enumerate-interval 1 (- i 1))))
   (enumerate-interval 1 n)))

練習2.41

和上面的類似，照着寫就行了

;; 產生1<=k<j<i<=n的整數組
(define (unique-triples n)
  (flatmap
   (lambda(i) (map
               (lambda(x)
                 (cons i x))
               (unique-pairs (- i 1))))
   (enumerate-interval 1 n)))

;; 判斷整數組的和是否等於s
(define (sum-equal? s)
  (lambda(t) (= (accumulate + 0 t) s)))

;; 尋找n以內的和爲s的整數組
(define (triple-sum s n)
  (filter (sum-equal? s) (unique-triples n)))

練習2.42

;; Exercise 2.42
;; N皇后
#lang racket
(require "prime-sum-pairs.rkt")
(require "sequence-operations.rkt")

;; N皇后
;; 當前棋盤的可能狀態用一組list表示，每個list表示一種皇后放置方法，每個list對應下標存放的數值表示這一列皇后放在哪一行
(define (queens board-size)
  (define (queen-cols k)  
    (if (= k 0)
        (list empty-board)
        (filter
         (lambda (positions) (safe? k positions))
         (flatmap
          (lambda (rest-of-queens)
            (map (lambda (new-row)
                   (adjoin-position new-row k rest-of-queens))
                 (enumerate-interval 1 board-size)))
          (queen-cols (- k 1))))))
  (queen-cols board-size))

;; 空棋盤
(define empty-board null)

;; 放入新的一列，new-row表示新放入的第k列皇后處於哪一行
(define (adjoin-position new-row k rest-of-queens)
  (cons new-row rest-of-queens))

;; 判斷第k列的皇后位置是否合法
(define (safe? k positions)
  ;; 判斷皇后所處行是否有重複，是否會在對角線碰撞
  (and (unique-first positions)
       ;; 判斷皇后是否在對角線碰撞
       (not-crash? positions)))
       
;; 判斷list中首元素是否是不重複
(define (unique-first l)
  (= (list-item-num l (car l)) 1))

;; 獲取list中某個給定值出現了幾次
(define (list-item-num l item)
  (length (filter (lambda(x) (= x item)) l)))

;; 判斷新皇后是否會和其他皇后碰撞
(define (not-crash? l)
  ;; 沿着對角線逐步檢查是否相撞
  ;; cur表示會與新皇后相撞的位置
  ;; direction爲±1，表示兩個對角線方向
  (define (check remain cur direction)
    (if (null? remain)
        #t
        (and (not (= (car remain) cur))
             (check (cdr remain) (+ cur direction) direction))))
  (and (check (cdr l) (+ (car l) 1) 1)
       (check (cdr l) (+ (car l) -1) -1)))

部分答案如下

練習2.43

原來的寫法，每次做flatmap時，調用一次queen-cols，線形調用，耗費的時間是

現在這種寫法，每次做flatmap時，調用board-size次queen-cols，變成了樹形遞歸調用，根據前面的知識，樹形遞歸調用耗費的時間是，隨問題規模呈指數增長，常數與執行一次調用耗費時間有關，顯然C大致爲

所以更改後的代碼，耗費時間大約爲

練習2.4

;; 在畫作上方畫兩幅更小的畫作
(define (up-split painter n)
  (if (= n 0)
      painter
      (let ((smaller (up-split painter (- n 1))))
        (below painter (beside smaller smaller)))))

練習2.45

;; split，d1表示小畫和大畫的組合方式，d2表示兩幅小畫的組合方式
(define (split d1 d2)
  (lambda (painter n)
    (if (= n 0)
        painter
        (let ((smaller ((split d1 d2) painter (- n 1))))
          (d1 painter (d2 smaller smaller))))))

練習2.46

沒什麼難度

;; Exercise 2.46
;; 向量
#lang racket

;; make
(define (make-vect x y)
  (cons x y))

;; selector
(define (xcor-vect v)
  (car v))
(define (ycor-vect v)
  (cdr v))

;; 加
(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 v s)
  (make-vect (* (xcor-vect v) s)
             (* (ycor-vect v) s)))

練習2.47

第一種

;; Exercise 2.47
;; frame
#lang racket

;; make
(define (make-frame origin edge1 edge2)
  (list origin edge1 edge2))

;; selector
(define (origin-frame f)
  (car f))
(define (edge1-frame f)
  (cadr f))
(define (edge2-frame f)
  (cadr (cdr f)))

第二種

;; Exercise 2.47
;; frame
#lang racket

;; make
(define (make-frame origin edge1 edge2)
  (cons origin (cons edge1 edge2)))

;; selector
(define (origin-frame f)
  (car f))
(define (edge1-frame f)
  (cadr f))
(define (edge2-frame f)
  (cdr (cdr f)))

練習2.48

;; Exercise 2.48
;; segment
#lang racket
(require "vector.rkt")
(provide (all-defined-out))

;; make
(define (make-segment v1 v2)
  (cons v1 v2))

;; selector
(define (start-segment s)
  (car s))
(define (end-segment s)
  (cdr s))

練習2.49

;; 畫出外框
(define (draw-outline frame)
  ;; 四個端點
  (let ((v1 (make-vect 0 1))
        (v2 (make-vect 0 0))
        (v3 (make-vect 1 0))
        (v4 (make-vect 1 1)))
    (segments->painter (list (make-segment v1 v2)
                             (make-segment v2 v3)
                             (make-segment v3 v4)
                             (make-segment v4 v1)))))

;; 畫X
(define (draw-x frame)
  ;; 四個端點
  (let ((v1 (make-vect 0 1))
        (v2 (make-vect 0 0))
        (v3 (make-vect 1 0))
        (v4 (make-vect 1 1)))
    (segments->painter (list (make-segment v1 v3)
                             (make-segment v2 v4)))))

;; 畫菱形
(define (draw-diamond frame)
  ;; 四個中點
  (let ((v1 (make-vect 0.0 0.5))
        (v2 (make-vect 0.5 1.0))
        (v3 (make-vect 1.0 0.5))
        (v4 (make-vect 0.5 0.0)))
    (segments->painter (list (make-segment v1 v2)
                             (make-segment v2 v3)
                             (make-segment v3 v4)
                             (make-segment v4 v1)))))

我必須承認我是從網上抄的

;; 畫揮手的小人
(define wave-painter-segments
  (segments->painter
   (list (make-segment (make-vect 0.2 0.0) (make-vect 0.4 0.4))
         (make-segment (make-vect 0.4 0.4) (make-vect 0.3 0.5))
         (make-segment (make-vect 0.3 0.5) (make-vect 0.1 0.3))
         (make-segment (make-vect 0.1 0.3) (make-vect 0.0 0.6))
         (make-segment (make-vect 0.0 0.8) (make-vect 0.1 0.5))
         (make-segment (make-vect 0.1 0.5) (make-vect 0.3 0.6))
         (make-segment (make-vect 0.3 0.6) (make-vect 0.4 0.6))
         (make-segment (make-vect 0.4 0.6) (make-vect 0.3 0.8))
         (make-segment (make-vect 0.3 0.8) (make-vect 0.4 1.0))
         (make-segment (make-vect 0.6 1.0) (make-vect 0.7 0.8))
         (make-segment (make-vect 0.7 0.8) (make-vect 0.6 0.6))
         (make-segment (make-vect 0.6 0.6) (make-vect 0.8 0.6))
         (make-segment (make-vect 0.8 0.6) (make-vect 1.0 0.4))
         (make-segment (make-vect 1.0 0.2) (make-vect 0.6 0.4))
         (make-segment (make-vect 0.6 0.4) (make-vect 0.8 0.0))
         (make-segment (make-vect 0.7 0.0) (make-vect 0.5 0.3))
         (make-segment (make-vect 0.5 0.3) (make-vect 0.3 0.0)))))

練習2.50

;; 水平翻轉
(define (flip-horiz painter)
  ((transform-painter painter
                      (make-vect 1.0 0.0)
                      (make-vect 0.0 0.0)
                      (make-vect 1.0 1.0))
   painter))

;; 順時針旋轉180度
(define (rotate180 painter)
  ((transform-painter painter
                      (make-vect 1 1)
                      (make-vect 0 1)
                      (make-vect 1 0))
   painter))

;; 順時針旋轉270度
(define (rotate270 painter)
  ((transform-painter painter
                      (make-vect 0 1)
                      (make-vect 0 0)
                      (make-vect 1 1))
   painter))

練習2.51

仿照beside的寫法

;; below
(define (below painter-bottom painter-top)
  (let ((paint-top
         (transform-painter painter-top
                            (make-vect 0.0 0.5)
                            (make-vect 1.0 0.5)
                            (make-vect 0.0 1.0)))
        (paint-below
         (transform-painter painter-bottom
                            (make-vect 0.0 0.0)
                            (make-vect 1.0 0.0)
                            (make-vect 0.0 0.5))))
    (lambda (frame)
      (paint-top frame)
      (paint-bottom frame))))

如果用beside加rotate實現below

;; beside實現below
(define (below-by-biside painter-bottom painter-top)
  (rotate270 (beside (rotate90 painter-bottom)
                      (rotate90 painter-up))))

練習2.52

給你畫個對角線

;; 畫揮手的小人
(define wave-painter-segments
  (segments->painter
   (list (make-segment (make-vect 0.0 0.0) (make-vect 1.0 1.0))
         (make-segment (make-vect 0.2 0.0) (make-vect 0.4 0.4))
         (make-segment (make-vect 0.4 0.4) (make-vect 0.3 0.5))
         (make-segment (make-vect 0.3 0.5) (make-vect 0.1 0.3))
         (make-segment (make-vect 0.1 0.3) (make-vect 0.0 0.6))
         (make-segment (make-vect 0.0 0.8) (make-vect 0.1 0.5))
         (make-segment (make-vect 0.1 0.5) (make-vect 0.3 0.6))
         (make-segment (make-vect 0.3 0.6) (make-vect 0.4 0.6))
         (make-segment (make-vect 0.4 0.6) (make-vect 0.3 0.8))
         (make-segment (make-vect 0.3 0.8) (make-vect 0.4 1.0))
         (make-segment (make-vect 0.6 1.0) (make-vect 0.7 0.8))
         (make-segment (make-vect 0.7 0.8) (make-vect 0.6 0.6))
         (make-segment (make-vect 0.6 0.6) (make-vect 0.8 0.6))
         (make-segment (make-vect 0.8 0.6) (make-vect 1.0 0.4))
         (make-segment (make-vect 1.0 0.2) (make-vect 0.6 0.4))
         (make-segment (make-vect 0.6 0.4) (make-vect 0.8 0.0))
         (make-segment (make-vect 0.7 0.0) (make-vect 0.5 0.3))
         (make-segment (make-vect 0.5 0.3) (make-vect 0.3 0.0)))))

;; corner split
(define (corner-split painter n)
  (if (= n 0)
      painter
      (let ((up (up-split painter (- n 1)))
            (right (right-split painter (- n 1)))
            (corner (corner-split painter (- n 1))))
        (beside (below painter up)
                (below right corner)))))

;; square limit
(define (square-limit painter n)
  (let ((combine4 (square-of-four identity flip-horiz
                                  flip-vert rotate180)))
    (combine4 (corner-split painter n))))

練習2.53

'(a b c)
'((george))
'((y1 y2)) 後面還有一個nil，所以是一個list，裏面包含(y1,y2)和nil
'(y1 y2)
#f
#f 檢查兩個元素(red shoes)和(blue socks)，均不等於red
'(red shoes blue socks)

練習2.54

;; Exercise 2.54
;; 判斷list是否相等
#lang racket

;; 判斷兩個list是否完全相等
(define (equal? l1 l2)
  (cond ((and (null? l1) (null? l2)) #t)
        ((or (null? l1) (null? l2) (not (eq? (car l1) (car l2)))) #f)
        (else (equal? (cdr l1) (cdr l2)))))

練習2.55

(car ''abracadabra)，展開就是(car '(quote abracadabra))

練習2.56

簡單寫了一個，僅支持指數爲數字的形式

先寫冪運算相關的make和selector

;; 判斷是否是求冪
(define (exp? x)
  (and (pair? x)
       (eq? (car x) '**)))

;; 求冪
(define (make-exp base exponent)
  (if (or (=number? base 1) (=number? exponent 0))
      1
      (list '** base exponent)))

;; 獲取冪的基數、指數
(define (base e) (cadr e))
(define (exponent e) (caddr e))

然後修改求導

;; 求導
(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))))
        ((exp? exp)
         (make-product (make-product (exponent exp)
                                     (make-exp (base exp) (- (exponent exp) 1)))
                       (deriv (base exp) var)))
        (else
         (error "unknwon expression type -- DERIV" exp))))

練習2.57

只修改augend和multiplicand的定義，舉個例子，addend還是保存第一項，augend保存之後的所有項的和

例如，(+ x y z)的addend是x，augend是(+ y z)

;; 獲取加數
(define (augend s)
  (let ((rest (cddr s)))
    (if (null? (cdr rest))
        (car rest)
        (cons '+ rest))))

;; 獲取乘數
(define (multiplicand p)
  (let ((rest (cddr p)))
    (if (null? (cdr rest))
        (car rest)
        (cons '* rest))))

練習2.58

;; 判斷是否是求和式
(define (sum? x)
  (and (pair? x) (eq? (cadr x) '+)))

;; 判斷是否是求積式
(define (product? x)
  (and (pair? x) (eq? (cadr x) '*)))

;; 獲取加數
(define (addend s) (car s))
(define (augend s) (caddr s))

;; 獲取乘數
(define (multiplier p) (car p))
(define (multiplicand p) (caddr p))

;; 求和
(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))))

需要考慮的情況是，當加法前含有乘法運算時，如何準確地識別加法

例如，4 * x + x * x，需要判定爲求和，並且拆分出4 * x和x * x，再對子項進行求導

那麼只需要在判斷表達式的死後，當表達式含有+，就判定爲加法，先行進行處理

;; 判斷是否是求和式
(define (sum? x)
  (contains? x '+))

;; 判斷是否是求積式
(define (product? x)
  (and (not (contains? x '+)) (contains? x '*)))

;; 判斷list中是否含有某元素
(define (contains? l item)
  (cond ((null? l) #f)
        ((eq? (car l) item) #t)
        (else (contains? (cdr l) item))))

乘法的selector修改成類似習題2.57中的樣子（但需要修改，注意*號的位置，不是最前面而是中間），以支持多項計算，加法的selector需要在“+”處切分

;; 從list中獲取指定item之前的部分
(define (get-before l item)
  (define (iter remain)
    (if (or (null? remain) (eq? (car remain) item))
        null
        (cons (car remain) (iter (cdr remain)))))
  (remove-brackets-if-only-one (iter l)))

;; 從list中獲取指定item之後的部分
(define (get-after l item)
  (define (iter remain)
    (cond ((null? remain) null)
          ((eq? (car remain) item) (cdr remain))
          (else (iter (cdr remain)))))
  (remove-brackets-if-only-one (iter l)))

;; 若list中只含有一個元素，去除括號
(define (remove-brackets-if-only-one l)
  (if (null? (cdr l))
      (car l)
      l))

;; 獲取加數
(define (addend s) (get-before s '+))
(define (augend s) (get-after s '+))

;; 獲取乘數
(define (multiplier p) (car p))
(define (multiplicand p)
  (let ((rest (cddr p)))
    (if (null? (cdr rest))
        (car rest)
        rest)))

練習2.59

;; 取並集
(define (union-set set1 set2)
  (cond ((or (null? set1) (null? set2)) set2)
        ((element-of-set? (car set1) set2)
         (union-set (cdr set1) set2))
        (else (cons (car set1) (union-set (cdr set1) set2)))))

練習2.60

由可重複列表構成的集合，代碼如下

;; Exercise 2.60
;; 允許重複的列表構成的集合
#lang racket

;; 判斷集合是否包含某個元素
(define (element-of-set? x set)
  (cond ((null? set) false)
        ((equal? x (car set)) true)
        (else (element-of-set? x (cdr set)))))

;; 在集合中加入元素
(define (adjoin-set x set)
  (cons x set))

;; 取交集 
(define (union-set set1 set2)
  (cond ((null? set1) set2)
        ((null? set2) set1)
        (else (union-set (cdr set1) (cons (car set1) set2)))))

;; 取並集
(define (intersection-set set1 set2)
  (cond ((or (null? set1) (null? set2)) null)
        ((element-of-set? (car set1) set2)
         (cons (car set1)
               (intersection-set (cdr set1) set2)))
        (else (intersection-set (cdr set1) set2))))

和由不可重複列表構成集合的各項操作複雜度對比

分類	element-of-set?	adjoin-set	union-set	intersection-set
重複列表	$\Theta (n)$	$\Theta (1)$	$\Theta (n)$	$\Theta (n^2)$
不可重複列表	$\Theta (n)$	$\Theta (n)$	$\Theta (n^2)$	$\Theta (n^2)$

雖然有部分操作複雜度降低了，但是帶來的是更大的存儲開銷，在數據重複度很高的情況下，重複列表的長度會比不重複列表大很多，操作也會變慢，因此需要根據應用來選擇合適的底層實現方式

練習2.61

;; Exercise 2.61
;; 有序列表構成的集合
#lang racket

;; 向集合增加元素
(define (adjoin-set x set1)
  (cond ((null? set1) (cons x null))
        ((= (car set1) x) set1)
        ((> (car set1) x) (cons x set1))
        (else (cons (car set1) (adjoin-set x (cdr set1))))))

練習2.62

;; 取交集
(define (union-set set1 set2)
  (cond ((null? set1) set2)
        ((null? 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)))
                 (else (cons x2 (union-set set1 (cdr set2)))))))))

練習2.63

兩種寫法都一樣，是前序遍歷

對於圖2.16，結果都是1 3 5 7 9 11

兩種寫法的遞歸調用次數都是差不多的，那麼就比較每一次的操作

第一種寫法使用了append操作，比第二種寫法的cons操作，顯然複雜度更高

練習2.64

非常多的let嵌套簡直驚悚，建議從下往上看，清晰很多

首先partial-tree有兩個輸入，一個是元素列表，一個是元素列表長度

partial-tree的返回是一個pair，從最後一行可以猜出，pair是已經組合好的樹和未處理的元素

再讀一讀let嵌套就可以知道，partial-tree先把左子樹的所有元素處理成樹，返回未處理的元素（包含entry和右子樹的所有元素），然後依次處理entry和右子樹

處理的結果是(5 (1 () (3 () ())) (9 (7 () ()) (11 () ())))

對每個元素都處理依次，因此複雜度爲 $\Theta (n)$

首先把二叉樹轉換成list，再按照需求進行交或並的歸併，再把處理好的list轉換成二叉樹

三種操作的複雜度都是 $\Theta (n)$

;; 取交集
(define (union-set set1 set2)
  (let ((list1 (tree->list-1 set1))
        (list2 (tree->list-1 set2)))
    ;; 取兩個有序列表交集
    (define (merge list1 list2)
      (cond ((null? list1) list2)
            ((null? list2) list1)
            (else
             (let ((x1 (car list1))
                   (x2 (car list2)))
               (cond ((= x1 x2) (cons x1 (merge (cdr list1) (cdr list2))))
                     ((< x1 x2) (cons x1 (merge (cdr list1) list2)))
                     (else (cons x2 (merge list1 (cdr list2)))))))))
    (let ((union-list (merge list1 list2)))
      (list->tree union-list))))

;; 取交集
(define (intersection-set set1 set2)
  (let ((list1 (tree->list-1 set1))
        (list2 (tree->list-2 set2)))
    ;; 取兩個有序列表並集
    (define (merge list1 list2)
      (if (or (null? list1) (null? list2))
          null
          (let ((x1 (car list1))
                (x2 (car list2)))
            (cond ((= x1 x2) (cons x1 (merge (cdr list1) (cdr list2))))
                  ((< x1 x2) (merge (cdr list1) list2))
                  (else (merge list1 (cdr list2)))))))
    (let ((intersection-list (merge list1 list2)))
      (list->tree intersection-list))))

練習2.66

;; 查找
(define (lookup set1 key)
  (if (null? set1)
      false
      (let ((x (entry set1)))
        (cond ((= x key) true)
              ((< x key) (lookup (right-branch set1) key))
              (else (lookup (left-branch set1) key))))))

練習2.67

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))))

;; 編碼一個symbol
(define (encode-symbol symbol tree)
  ;; 判斷有序集合中是否含有某元素
  (define (contains? set1 s)
    (cond ((null? set1) false)
          ((equal? (car set1) s) true)
          (else (contains? (cdr set1) s))))
  ;; 判斷子樹是否包含symbol
  (define (tree-contains? s t)
    (contains? (symbols t) s))
  (cond ((leaf? tree) null)
        ((tree-contains? symbol (left-branch tree))
         (cons 0 (encode-symbol symbol (left-branch tree))))
        ((tree-contains? symbol (right-branch tree))
         (cons 1 (encode-symbol symbol (right-branch tree))))
        (else (error ("待加密信息輸入錯誤")))))
         
;; 測試編碼      
(define sample-characters '(A D A B B C A))
(encode sample-characters sample-tree)

練習2.69

;; 將最小的元素合併爲一個節點
(define (successive-merge ordered-pairs)
  (if (= (length ordered-pairs) 1)
      (car ordered-pairs)
      (let ((leaf1 (car ordered-pairs))
            (leaf2 (cadr ordered-pairs))
            (remains (cddr ordered-pairs)))
        (successive-merge (adjoin-set (make-code-tree leaf1 leaf2) remains)))))

練習2.70

利用霍夫曼編碼，只要84位bit，定長3-bit編碼需要108位

練習2.71

對於這種頻率，在合併樹節點的時候，兩個最小的節點合併後仍然是最小的節點，n=5的時候霍夫曼樹如下

因此這種情況，頻率最高的節點，霍夫曼編碼是1位，頻率最低的節點，霍夫曼編碼是n-1位

練習2.72

對一個長度爲n的message，假設單詞爲m個，調用n次encode函數，每個encode函數調用一次encode-symbol

一次encode-symbol，每次都要在節點的set中搜尋symbol是否存在，然後沿着節點一次向下搜尋沿着節點，所以複雜度和霍夫曼樹是否平衡有關。在不知道霍夫曼樹結構的情況下，計算複雜度是很困難的

以練習2.71中的霍夫曼樹爲例

對於最頻繁出現的symbol，在第一個節點set中搜尋即可找到，第一個節點set長度爲n，所以複雜度是 $\Theta (n)$

對於最不頻繁出現的symbol，要在(n-1)個節點的set中搜尋，每個set的長度與n成正比，所以複雜度是 $\Theta (n^2)$

練習2.73

數據導向的求導程序

因爲數字和符號已經有了內置的number?、variable?這種函數，如果對數字、變量也打數據標籤，要多很多操作

先把給數據打標籤的代碼寫好

;; 帶標籤數據
#lang racket
(provide (all-defined-out))

;; 給數據打標籤
(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)))

sum和product的install代碼

;; sum數據類型
(define (install-sum-package)
  ;; 內部函數
  ;; 構造函數
  (define (make-sum x y)
    (cond ((=number? x 0) y)
          ((=number? y 0) x)
          ((and (number? x) (number? y)) (+ x y))
          (else (attach-tag '+ x y))))
  ;; 獲取第一個加數
  (define (addend s)
    (car s))
  ;; 獲取第二個加數
  (define (augend s)
    (cadr s))
  ;; 求導
  (define (diff-sum operands var)
    (make-sum (deriv (addend operands) var)
              (deriv (augend operands) var)))
  ;; 註冊函數
  (put 'deriv '+ diff-sum))
  (put 'make  '+ make-sum))

;; product數據類型
(define (install-product-package)
  ;; 內部函數
  ;; 構造函數
  (define (make-product x y)
    (cond ((=number? x 1) y)
          ((=number? y 1) x)
          ((or (=number? x 0) (=number? y 0)) 0)
          ((and (number? x) (number? y)) (+ x y))
          (else (attach-tag '* x y))))
  ;; 獲取第一個乘數
  (define (multiplier s)
    (car s))
  ;; 獲取第二個乘數
  (define (multiplicand s)
    (cadr s))
  ;; 求導
  (define (diff-product operands var)
    (make-sum (make-product
               (multiplier operands)
               (deriv (multiplicand operands) var))
              (make-product
               (deriv (multiplier operands) var)
               (multiplicand operands))))
  ;; 接口
  (put 'deriv '* diff-product)
  (put 'make  '* make-product))

(define make-sum (get 'make '+))
(define make-product (get 'make '*))

;; 指數數據類型
(define (install-exp-package)
  ;; 內部函數
  ;; 構造函數
  (define (make-exp x y)
    (cond ((=number? y 0) 1)
          ((=number? y 1) x)
          ((and (number? x) (number? y)) (** x y))
          (else (attach-tag '** x y))))
  ;; 獲取基數
  (define (base s)
    (car s))
  ;; 獲取指數
  (define (exponent s)
    (cadr s))
  ;; 求導
  (define (diff-exp operands var)
    (let ((b (base operands))
          (e (exponent operands)))
      (make-product e
                    (make-product (deriv e var)
                                  (make-exp b (make-sum e -1)))))
  ;; 接口
  (put 'deriv '** diff-exp)
  (put 'make  '** make-exp))

把所有put操作的前兩個參數調換位置就可以了

2.74

由題意，每個獨立文件以不同的數據結構存放員工信息，以員工姓名爲主鍵

每個文件的數據都分配一個tag，都公開以下接口：

通過員工姓名查詢員工信息記錄的get函數
各種select函數，包括薪水、入職日期等

get_record函數通過員工姓名在文件中查詢員工信息，在不同文件中查詢時，只要根據不同的數據tag選擇對應的get函數就可以了

通過每條員工信息的數據tag，選擇對應的select函數，查詢薪水

在不同文件中搜索，直到搜索到該姓名爲止

分配給新公司一個tag，並在它原來的員工數據基礎上，增加對應的get和select函數

2.75

這個message寫起來比tag簡單多了

偉大的面向對象思想

;; 極座標
(define (make-from-mag-ang m a)
  (define (dispatch op)
    (cond ((eq? op 'magnitude) m)
          ((eq? op 'angle) a)
          ((eq? op 'real-part) (* m (cos a)))
          ((eq? op 'imag-part) (* m (sin a)))
          (else
           (error "Unknown op -- MAKE-FROM-MAG-ANG" op))))
  dispatch)

2.76

顯式分派：非常麻煩，每個類型的每個方法名字要注意區分，大型系統中簡直是噩夢的存在

tag：增加類型，要分配一個新tag，並更新全局函數表；增加方法要更新全局函數表；之前的代碼無需修改

message：增加類型幾乎不需要額外的開銷；增加方法，其實和tag相比要加入的代碼量是類似的，但是tag法的方法代碼可以不和同類代碼放在一起，message的方法必須和類寫在一個dispatch函數裏，所以tag法增加方法更加地方便一些（寫起來方便，寫的量我覺得差不多）

綜上，經常增加類，使用message法，經常增加方法，使用tag法

練習2.77

magnitude只在install函數內部定義了，其他函數無法直接調用install函數內部定義的函數

練習2.78

加個判斷分支就好，number和symbol不打tag，獲取標籤的時候，判斷爲number?或symbol?的直接返回對應tag

;; Exercise 2.78
;; 帶標籤數據，可處理系統自帶number和symbol
#lang racket

;; 給數據打標籤
(define (attach-tag type-tag contents)
  (if (or (number? contents) (symbol? contents))
      contents
      (cons type-tag contents)))

;; 獲取數據標籤
(define (type-tag datum)
  (cond ((number? datum) 'number)
        ((symbol? datum) 'symbol)
        ((pair? datum) (car datum))
        (else (error "Bad tagged datum -- TYPE-TAG" datum))))

;; 獲取數據內容
(define (contents datum)
  (cond ((or (number? datum) (symbol? datum)) datum)
        ((pair? datum) (cdr datum))
        (else (error "Bad tagged datum -- CONTENTS" datum))))

練習2.79

以下代碼需要放在各install包裏

;; Exercise 2.80
;; 泛型數字操作
#lang racket

;; 判斷有理數是否相等
(define (rational-eq? r1 r2)
  (= (* (numer r1) (denom r2))
     (* (denom r1) (numer r2))))
(put 'equ? 'rational rational-eq?)

;; 判斷複數是否相等
(define (complex-eq? c1 c2)
  (and (= (real-part c1) (real-part c2))
       (= (imag-part c1) (imag-part c2))))
(put 'equ? 'complex complex-eq?)

;; 判斷數字是否相等
(define (number-eq? n1 n2)
  (= n1 n2))
(put 'equ? 'number number-eq?)

練習2.80

類似操作

;; Exercise 2.80
;; 泛型數字操作
#lang racket

;; 判斷有理數是否爲零
(define (rational-zero? r)
  (= (numer r) 0))
(put 'zero? 'rational rational-zero?)

;; 判斷複數是否爲零
(define (complex-zero? c)
  (and (= (real-part c) 0) (= (imag-part c) 0)))
(put 'zero? 'complex complex-zero?)

;; 判斷數字是否爲0
(define (number-zero? n)
  (= n 0))
(put 'zero? 'number number-zero?)

練習2.81

apply-generic函數有兩個分支：一個分支是找到當前輸入類型對應的操作函數，調用函數，完成操作；或者嘗試輸入數據的類型轉換，再用新輸入類型調用apply-generic

如果加上scheme-number自身的轉換，(apply-generic scheme-number scheme-number)會重複a1->a2類型轉換，然後調用(apply-generic scheme-number scheme-number)，程序陷入死循環

從上一小題分析可以看出來，apply-generic首先查找是否有對應輸入類型的操作函數，查找不到就會嘗試進行類型轉換；如果加入同類型轉換的函數，轉換前後沒有任何改變，找不到操作函數還是找不到，必然會引起死循環調用

;; Exercise 2.81
;; 泛型函數
#lang racket

;; 泛型操作
(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 (equal? type1 type2)
                    (error "No method for these types")
                    (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 method for these types"
                                    (list op type-tags)))))))
              (error "No method for these types")
                     (list op type-tags))))))

練習2.82

這種實現方式，如果存在輸入類型不同的通用函數，比如(exp scheme-number complex)，是不能找到這個通用函數的，只能找到所有輸入類型都是一樣的通用函數

;; 多輸入泛型操作
(define (apply-generic op . args)
  ;; 嘗試轉換arg爲type類型
  (define (change-type type arg)
    (let ((change-proc (get-coercion (type-tags arg) type)))
      (if change-proc
          (apply change-proc arg)
          arg)))
  ;; origin-types表示最初輸入參數的類型list
  (define (iter origin-types changed-args)
    ;; 查找對應輸入類型的函數
    (let ((type-tags (map type-tag changed-args)))
      (let ((proc (get op type-tags)))
        (if proc
            ;; 如果找到對應輸入類型的函數
            (apply proc (map contents changed-args))
            ;; 如果沒有找到，轉換爲origin-types中的首元素類型
            (if (null? origin-types)
                ;; 已經嘗試了所有類型，仍未找到，報錯
                (error "No method for these types")
                ;; 轉換參數類型，遞歸調用
                (iter (cdr origin-types) (map change-type args)))))))
  ;; 調用
  (iter (map type-tag args) args))

《SICP》習題第2章

如何使用 JS 判斷用戶是否處於活躍狀態

通過HPA+CronHPA組合應對業務複雜彈性伸縮場景

Centos6.10下Open-falcon的分佈式安裝（虛擬機僞分佈式）和前端界面安裝

Elasticsearch學習（零）——安裝與基本操作

Centos6下Redis學習（一）——Java客戶端Lettuce的使用、Springboot整合

LeetCode困難刷題記錄——Median of Two Sorted Arrays 尋找兩個有序數組的中位數

Centos6.10下Open-falcon學習記錄（三）——log監控插件falcon-log-agent

https://yachay.unat.edu.pe/blog/index.php?comment_area=format_blog&comment_component=blog&comment_co

linux以太網驅動總結