(begin    (load "ex1.scm")    ;(define (make-rat n d) (cons n d))    (define (numer x) (car x))    (define (denom x) (cdr x))    (define (print-rat x)      (display (numer x))      (display "/")      (display (denom x))      (newline))    ;ex 2.1        (define (positive? x) (> x 0))        (define (negative? x) (< x 0))    (define (make-rat n d)        (let ((g (gcd n d)))        (if (positive? (* n d))            (cons (/ (abs n) g) (/ (abs d) g))            (cons (/ (- (abs n)) g) (/ (abs d) g)))))    ;ex 2.2    (define (make-point x y)        (cons x y))    (define (x-point p)(car p))    (define (y-point p)(cdr p))        (define (print-point p)        (display "x:")        (display (x-point p))        (display " y:")        (display (y-point p))        (newline)    )    (define (make-segment p1 p2) (cons p1 p2))    (define (start-segment s)(car s))    (define (end-segment s)(cdr s))    (define (print-segment s)        (display "[start:")        (display (x-point (start-segment s)))        (display " ")        (display (y-point (start-segment s)))        (display "] ")        (display "[end:")        (display (x-point (end-segment s)))        (display " ")        (display (y-point (end-segment s)))        (display "]")        (newline)            )    ;线段长度    (define (length-segment s)        (sqrt (+ (square (- (x-point (start-segment s)) (x-point (end-segment s))))             (square (- (y-point (start-segment s)) (y-point (end-segment s)))))))    ;线段中点             (define (midpoint-segment s)        (make-point (average (x-point (start-segment s)) (x-point (end-segment s)))         (average (y-point (start-segment s)) (y-point (end-segment s)))))    ;ex 2.3    ;使用2端点定义矩形    (define (make-rectangle t-left b-right)        (if (= (y-point t-left) (y-point b-right))            (error "can't make a rectangle");如果两点构成的线段平行与x轴则无法构成矩形            (cons t-left b-right)))    (define (top-left r) (car r))    (define (bottom-right r) (cdr r))    ;计算矩形的周长            (define (perimeter-rectangle r)        (* 2        (+ (abs (- (y-point (top-left r)) (y-point (bottom-right r))))           (abs (- (x-point (top-left r)) (x-point (bottom-right r)))))))    ;计算矩形面积    (define (area-rectangle r)        (* (abs (- (y-point (top-left r)) (y-point (bottom-right r))))           (abs (- (x-point (top-left r)) (x-point (bottom-right r))))))    ;ex 2.4    (define (cons1 x y)        (lambda (m) (m x y)))    (define (car1 z)        (z (lambda (p q) p)))    (define (cdr1 z)        (z (lambda (p q) q)))    ;ex 2.5 看下 2^2 * 3^3的二进制表示,注:序对不能有负数    (define (cons2 x y) (* (fast-expt 2 x) (fast-expt 3 y)))    (define (car2 z)        (define (iter n z)            (if (= (remainder z 2) 0)                (iter (+ n 1) (/ z 2))                 n))        (iter 0 z))    (define (cdr2 z)        (define (iter n z)            (if (= (remainder z 3) 0)                (iter (+ n 1) (/ z 3))                 n))        (iter 0 z))    ;ex 2.17        (define (last-pair p)        (define (last-pair-imp front back)            (if (null? back)                (list front)                (last-pair-imp (car back) (cdr back))))        (if (null? p)            p            (last-pair-imp (car p) (cdr p))))    ;ex 2.18    ;递归    (define (reverse p)        (define (reverse-pair-imp front back)            (cond ((null? back) (list front))                  (else (append (reverse-pair-imp (car back) (cdr back)) (list front)))))        (if (null? p)            p            (reverse-pair-imp (car p) (cdr p))))    ;迭代    (define (reverse2 items)      (define (iter things answer)        (if (null? things)            answer            (iter (cdr things)                   (cons (car things)                        answer))))      (iter items nil))                ;ex 2.19    (define us-coins (list 50 25 10 5 1))    (define uk-coins (list 100 50 20 10 5 2 1 0.5))    ;: (cc 100 us-coins)    (define no-more? null?)    (define except-first-denomination cdr)    (define first-denomination car)    (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)))))                ;ex 2.20    (define (same-parity x . y)        (define (same-parity-imp checker front back)            (define (process front) (if (checker front)(list front)nil))                (if (null? back)(process front)                (append (process front) (same-parity-imp checker (car back) (cdr back)))))        (if (even? x) (same-parity-imp even? x y)            (same-parity-imp odd? x y)))    ;ex 2.21    (define (square-list1 items)        (map square items))    ;ex 2.22    (define (square-list2 items)      (define (iter things answer)        (if (null? things)            answer            (iter (cdr things)                   (cons (square (car things))                        answer))))      (reverse2 (iter items nil)))     ;ex 2.23    (define (for-each proc items)      (define (iter things)        (cond ((null? things))            (else                (proc (car things))                (iter (cdr things)))))     (iter items))    ;ex 2.27    (define (deep-reverse tree)        (cond ((null? tree) nil)              ((not (pair? tree)) tree)              (else (reverse (map deep-reverse tree)))))              ;ex 2.28    (define (fringe tree)        (cond ((null? tree) nil)              ((not (pair? tree))(list tree))              (else (append (fringe (car tree)) (fringe (cdr tree))))))    ;ex 2.30 使用map    (define (square-tree tree)            (cond ((null? tree) nil)            ((not (pair? tree)) (square tree))            (else (map square-tree tree))))    ;ex 2.30直接定义            (define (square-tree2 tree)        (cond ((null? tree) nil)            ((not (pair? tree)) (square tree))            (else (cons (square-tree2 (car tree))                        (square-tree2 (cdr tree))))))    ;ex 2.31    (define (tree-map func tree)        (define (tree-map-imp tree)                (cond ((null? tree) nil)                ((not (pair? tree)) (func tree))                (else (map tree-map-imp tree))))        (tree-map-imp tree))    (define (square-tree3 tree) (tree-map square tree))    ;ex 2.32 产生子集合的方式,将集合a分成两部分(front back)    ;a的子集合 = back的子集合 + 将front插入到back的所有子集合中产生的集合     (define (subsets s)      (if (null? s)          (list nil)          (let ((rest (subsets (cdr s))))            (display "rest:")(display rest)(newline)            (append rest (map (lambda (rest) (cons (car s) rest)) rest)))))    ;ex 2.33    (define (map2 p sequence)        (accumulate (lambda (x y) (cons (p x) y)) nil sequence))    (define (append2 seq1 seq2)        (accumulate cons seq2 seq1))    (define (length2 sequence)        (accumulate (lambda (_ counter) (+ 1 counter)) 0 sequence))    ;ex 2.34    (define (horner-eval x coefficient-sequence)      (accumulate (lambda (this-coeff higher-terms) (+ this-coeff (* x higher-terms)))                0                coefficient-sequence))    ;: (horner-eval 2 (list 1 3 0 5 0 1))    ;ex 2.35    (define (count-leaves2 t)        (define (cal node count)            (if (pair? node) (+ (accumulate cal 0 node) count);当前节点的叶子数+其它兄弟的叶子数                (+ 1 count))        )        (accumulate cal 0 t))        ;map fringe将((1 11) 10 (2 (3 4 5 (7 8))))) 展开成 ((1 11) (10) (2 3 4 5 7 8))    ;分别计算每个子表的length累加即可        (define (count-leaves3 t)            (accumulate (lambda (node counter) (+ (length node) counter)) 0 (map fringe t)))    ;ex 2.36    (define a_s (list (list 1 2 3) (list 4 5 6) (list 7 8 9) (list 10 11 12)))    (define (accumulate-n op init seqs)      (if (null? (car seqs))          nil          (cons (accumulate op init (map car seqs))                (accumulate-n op init (map cdr seqs)))))    ;ex 2.37    (define _mat (list (list 1 2 3) (list 4 5 6) (list 7 8 9)))    (define (transpose mat) ;矩阵转置        (accumulate-n cons nil mat))    ;其余两个略去...        ;ex 2.38    ;fold-right和fold-left的主要区别    ;fold-right op会首先被应用到最右边的成员    ;fold-left  op首先被应用到最左边的成员    ;要想op对fold-right和fold-left的任何输入序列都输出相同的结果,op必须满足交换率    (define fold-right accumulate)    (define (fold-left op initial sequence)      (define (iter result rest)        (if (null? rest)            result            (iter (op result (car rest))                  (cdr rest))))      (iter initial sequence))    ;ex 2.39    (define (reverse3 sequence)        (fold-right (lambda (x y) (append y (list x))) nil sequence))    (define (reverse4 sequence)        (fold-left (lambda (x y) (cons y x)) nil sequence))    ;ex 2.40    (define (unique-pairs n)        (define (process i)            (map (lambda (j) (list i j)) (enumerate-interval 1 (- i 1)))        )     (accumulate append nil (map process (enumerate-interval 1 n))))    (define (prime-sum? pair)        (prime? (+ (car pair) (cadr pair))))    (define (make-pair-sum pair)        (list (car pair) (cadr pair) (+ (car pair) (cadr pair))))         (define (prime-sum-pairs n)        (map make-pair-sum (filter prime-sum? (unique-pairs n))))    ;ex 2.41    (define (m-pairs2 n m)        (define (iter l j ret)            (cond ((< j 1)                (list ret))                (else                (accumulate                 append                 nil                 (map (lambda (x)                       (cond ((< x j) nil)                              (else (iter (- x 1) (- j 1) (cons x ret)))))                        (enumerate-interval 1 l))))))        (iter n m nil))            ;(define (unique-pairs n) (m-pairs n 2))    ;(((1 2)(3 4))(5 6))->((1 2)(3 4)(5 6))    (define (flat seq)        (define (iter seq ret)            (cond ((not (pair? seq)) ret)                  ((null? (car seq)) (cons nil ret))                  ((pair? (car seq))                    ;可以替换这两行看下区别                    ;(let ((ret2 (iter (car seq) ret)))                    ;     (iter (cdr seq) ret2)))                                           (let ((ret2 (iter (cdr seq) ret)))                         (iter (car seq) ret2)))                  (else (cons seq ret)))                      )        (iter seq nil)    )            ;给定一个列表,从中提取n个所有集合    ;例如(a b c d)->((a b c) (a c d) (a b d) (b c d))    ;这个简单的问题整了我一天多,对函数式语言还是不熟啊    (define (pick-n seq n)        ;(d-table (1 2 3) 1)->((1 2 3) (2 3) (3))        ;(d-table (1 2 3) 2)->((1 2 3) (2 3))        ;(d-table (1 2 3) 3)->((1 2 3))        (define (d-table seq n)            (cond ((= n 0) nil)                  (else                    (if (<= (length seq) n) (list seq)                        (cons seq (d-table (cdr seq) n ))))))            (define (process seq)            (let ((size (length seq)))                (cond ((<= n 1) (if (pair? seq) (list (car seq)) seq))                      ((<= size n) seq)                          (else                         (map (lambda (x)(cons (car seq) x)) (pick-n (cdr seq) (- n 1))))))                              )        (flat (map process (d-table seq n)))    )    ;更简单的实现    (define (pick2-n seq n)        (define (d-table seq n)            (cond ((= n 0) nil)                  (else                    (if (<= (length seq) n) (list seq)                        (cons seq (d-table (cdr seq) n ))))))            (define (process seq)            (let ((size (length seq)))                (cond ((<= n 1) (if (pair? seq) (list (car seq)) seq))                      ((<= size n) (list seq))                          (else                         (map (lambda (x)                                (if (pair? x)(cons (car seq) x)                                    (cons (car seq) (list x)))) (pick2-n (cdr seq) (- n 1))))))                              )        (flatmap process (d-table seq n))    )    (define (pick3-n seq n)        ;从n个中选m个->从n-1个中选m个的集合+(将头部取出插入到从n-1个中选m-1个的集合)        (define (process seq)            (cond ((<= n 0) (list nil))                  ((<= (length seq) n) seq)                  (else                     (cons (pick3-n (cdr seq) n) (map (lambda (x)(cons (car seq) x)) (pick3-n (cdr seq) (- n 1)))))                  )        )        (flat (process seq))    )    (define (unique-pairs2 n) (pick-n (enumerate-interval 1 n) 2))    ;(define (3-pairs n) (pick-n (enumerate-interval 1 n) 3))    (define (m-pairs n m) (pick-n (enumerate-interval 1 n) m))    ;flatmap练习    (define (test1 i)        (define (process x)            (map (lambda (y) (list x y))(enumerate-interval 1 x))         )        (flatmap process (enumerate-interval 1 i))    )    (define (test2 i j)        (define (process x)            (map (lambda (y) (list x y))(enumerate-interval 1 j))         )        (flatmap process (enumerate-interval 1 i))    )    ;(flatmap (lambda (x) (map square x)) (list (list 1) (list 2)))    ;2.31引号    ;'后的对象表示对象应该作为数据而不是该求值的表达试对待    ;(accumulate (lambda (x y) (cons (list x) y)) nil ''a)    ;''a 表示一个列表其内容为(quote a)与(list 'quote 'a),'(quote a)等价    ;(cons 'quote 'a)->(quote . a)    ;(cons 'quote (list 'a))-> ''a    ;(accumulate (lambda (x y) (cons (list x) y)) nil (car '('a))    ;'('a)表示列表中有一个元素为('a) (car '('a)) 等价于 ''a    ;比较''a 于 '('a)的区别(car (cdr ''a)) = (car (cdr (car '('a)))) = 'a        ;ex 2.56        (define (variable? x) (symbol? x))    (define (same-variable? v1 v2)      (and (variable? v1) (variable? v2) (eq? v1 v2)))    ;(define (make-sum a1 a2) (list '+ a1 a2))    ;(define (make-product m1 m2) (list '* m1 m2))    (define (sum? x)      (and (pair? x) (eq? (car x) '+)))    (define (addend s) (cadr s))    (define (augend s) (caddr s))    (define (product? x)      (and (pair? x) (eq? (car x) '*)))    (define (multiplier p) (cadr 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 (=number? exp num)      (and (number? exp) (= exp num)))    (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))))    ;用base^expon表示base的expon次幂    (define (make-exponentiation base expon)        (if (number? expon)            (cond ((= expon 0) 1)                  ((= expon 1) base)                      (else (list '^ base expon)))            (list '^ base expon))          )    (define make-exp make-exponentiation)    (define (exponentiation? e)        (if (pair? e)(eq? (car e) '^)#f))    (define is-exp? exponentiation?)    (define (base e)        (if (not is-exp?) (error "e is not a exponentiation")            (car (cdr e))))                (define (exponent e);获得指数        (if (not is-exp?) (error "e is not a exponentiation")            (car (cddr e))))            (define (exponent-dec e);指数-1        (let ((expon (exponent e)))            (if (number? expon) (make-exp (base e) (- expon 1))                (make-exp (base e) (list '- expon 1)))))        (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))))            ;对幂的处理            ((is-exp? exp)              (make-product (make-product (exponent exp) (exponent-dec exp))               (deriv (base exp) var))                )            (else             (error "unknown expression type -- DERIV" exp))))        ;ex 2.57    (define (augend s)        (if (> (length (cddr s)) 1) (append (list '+) (cddr s))            (caddr s)))    (define (multiplicand p)            (if (> (length (cddr p)) 1) (append (list '*) (cddr p))            (caddr p)))    ;ex 2.58            ;中缀表示    (define (sum? x)      (and (pair? x) (eq? (cadr x) '+)))    (define (addend s) (car s))    (define (augend s)                (if (> (length (cddr s)) 1) (cddr s)            (caddr s)))    (define (product? x)      (and (pair? x) (eq? (cadr x) '*)))    (define (multiplier p) (car p))    (define (multiplicand p)                    (if (> (length (cddr p)) 1) (cddr 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))))        ;(deriv '(x * y * (x + 3)) 'x)    ;(deriv '(x + 3 * (x + y + 2)))