[Back]

2.2 层次性数据和闭包性质

2.17

(define (last-pair lis)
    (if (null? (cdr lis))
        (car lis)
        (last-pair (cdr lis))))

2.18

(define (reverse lis)
    (define (reverse-cons lis res)
        (if (null? lis)
            res
            (reverse-cons (cdr lis) (cons (car lis) res))))
    (reverse-cons lis `()))

2.19

(define (cc amount coin-values)
    (define (no-more? coin-values)
        (if (null? coin-values) #t #f))
    (define (except-first-denomination coin-values)
        (cdr coin-values))
    (define (first-denomination coin-values)
        (car 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)))))

不会有影响,因为在总价固定的情况下,换得零钱的顺序是不影响方案数的。

2.20

(define (filtered-accumulate-list combiner term lis filter)
    (define (iter lis result)
        (cond ((null? lis) result)
              ((filter (term (car lis))) (iter (cdr lis) (combiner (term (car lis)) result)))
              (else (iter (cdr lis) result))))
    (iter lis `()))
(define (same-parity x . res)
    (define (is-same-parity? x)
        (lambda (a) (= (remainder a 2) (remainder x 2))))
    (reverse (filtered-accumulate-list cons id (cons x res) (is-same-parity? x))))

改写了一个对表的过滤器和累积后,形式就优美了很多

2.21

(define (square-list items)
    (if (null? items)
        nil
        (cons (* (car items) (car items))
            (square (cdr items)))))
(define (square-list items)
    (map square items))

2.22

因为在迭代result的时候,每一项新的项都被组合到了前面的位置。

而交换了顺序以后,nil被放置到了前面,显然这并不会构成一个表,而只是一个表结构。

2.23

(define (for-each proc lis)
    (if (null? lis)
        #t
        (and (proc (car lis)) (for-each proc (cdr lis)))))
; 迭代检查
; 还有一种直接扔掉的实现是
(define (for-each pro lis)
    (if (not (null? lis))
        ((proc (car lis)) (for-each proc (cdr lis)))))

2.24

解释器打印出来的是

(1 (2 (3 4)))

2.25

1)cadaddr 2)caar 3)cadadadadadadr

2.26

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

2.27

(define (reverse-tree tree)
    (define (iter tree res)
        (cond ((null? tree) res)
              (else (iter (cdr tree)
                    (cons (if (pair? (car tree))
                            (reverse-tree (car tree))
                            (car tree)) res)))))
    (iter tree `()))

2.28

(define (fringe tree)
    (cond ((null? tree) `())
          ((not (pair? tree)) (list tree))
          (else (append (fringe (car tree)) (fringe (cdr tree))))))

2.29

; A)
(define (left-branch mobile)
    (car mobile))
(define (right-branch mobile)
    (car (cdr mobile)))
(define (branch-length branch)
    (car branch))
(define (branch-structure branch)
    (car (cdr branch)))

; B)
(define (total-weight mobile)
    (define (branch-check branch)
        (cond ((null? branch) 0)
              ((not (pair? (branch-structure branch))) (branch-structure branch))
              (else (total-weight (branch-structure branch)))))
    (cond ((null? mobile) 0)
          ((not (pair? mobile)) mobile)
          (else (+ (branch-check (left-branch mobile))
                    (branch-check (right-branch mobile))))))

; C)
(define (balanced? mobile)
    (cond ((null? mobile) #t)
          ((not (pair? mobile) ) #t)
          (else 
            (let ((left-structure (branch-structure (left-branch mobile)))
                  (right-structure (branch-structure (right-branch mobile)))
                  (left-length (branch-length (left-branch mobile)))
                  (right-length (branch-length (right-branch mobile))))
                (and (balanced? left-structure) (balanced? right-structure)
                    (= (* left-length (total-weight left-structure))
                        (* right-length (total-weight right-structure))))))))
; D)
; 只需要修改选择函数
(define (left-branch mobile)
    (car mobile))
(define (right-branch mobile)
    (cdr mobile))
(define (branch-length branch)
    (car branch))
(define (branch-structure branch)
    (cdr branch))
; 这再次证明了抽象屏障的强大

2.30

(define (square-tree tree)
    (cond ((null? tree) `())
          ((not (pair? tree)) (* tree tree))
          (else (cons (square-tree (car tree))
                      (square-tree (cdr tree))))))
(define (square-tree-map tree)
    (map (lambda (sub-tree)
            (if (pair? sub-tree)
                (square-tree-map sub-tree)
                (* sub-tree sub-tree)))
        tree))

2.31

(define (tree-map f tree)
    (map (lambda (sub-tree) 
        (if (pair? sub-tree)
            (tree-map f sub-tree)
            (f sub-tree)))
        tree))

2.32

(define (subsets s)
    (if (null? s)
        (list `())
        (let ((rest (subsets (cdr s))))
            (append rest (map (lambda (res) (cons (car s) res)) rest)))))

这边有一个深刻的教训,`()始终只是一个值而不是列表,所以必须写(list `())

这个原理非常简单,就是对后续处理完毕的子集添加当前元素生成多个新子集,且根据无后效性的递归,必定不存在重复,复杂度应该是

2.33

(define (map p seq)
    (accumulate (lambda (x y) (cons (p x) y)) `() seq))
(define (append seq1 seq2)
    (accumulate cons seq2 seq1))
(define (length seq)
    (accumulate (lambda (x y) (+ 1 y)) 0 seq))

2.34

(define (horner-eval x coefficent-sequence)
    (accumulate (lambda (this-coeff higher-terms) (+ this-coeff (* x higher-terms)))
        0
        coefficent-sequence))

2.35

(define (count-leaves t)
    (accumulate + 0 (map (lambda (x)
        (if (not (pair? x))
            1
            (count-leaves x))) t)))

2.36

(define (accumulate-n op init seqs)
    (if (null? (car seqs))
        `()
        (cons (accumulate op init (map (lambda (x) (car x)) seqs))
              (accumulate-n op init (map (lambda (x) (cdr x)) seqs)))))

2.37

(define (dot-product v w)
    (accumulate + 0 (map * v w)))
(define (martrix-*-vector m v)
    (map (lambda (x) (dot-product x v)) m))
(define (transpose mat)
    (accumulate-n cons `() mat))
(define (martrix-*-martrix m n)
    (let ((cols (transpose n)))
        (map (lambda (x) (martrix-*-vector cols x)) m)))

2.38

3/2

1/6

(1(2(3 `())))

(((`() 1)2)3)

显然需要运算符满足交换律

2.39

(define (reverse sequence)
    (fold-right (lambda (x y) (append y (list x))) `() sequence))
(define (reverse sequence)
    (fold-left (lambda (x y) (cons y x)) `() sequence))

2.40

(define (unique-pairs n)
    (flatmap (lambda (i) (map (lambda (j) (list i j)) (enumurate-interval 1 (- i 1)))) (enumurate-interval 1 n)))
(define (prime-sum-pairs n)
    (filter prime-sum? (unique-pairs n)))

2.41

(define (unique-three-pairs n)
    (flatmap (lambda (i) (flatmap (lambda (j) 
        (map (lambda (k) (list i j k)) (enumurate-interval 1 (- j 1))))
        (enumurate-interval 1 (- i 1))))
        (enumurate-interval 1 n)))

(define (sum-three-equals-s n s)
    (define (sum-equals-s? sequence)
        (= (+ (car sequence)
        (car (cdr sequence))
            (car (cdr (cdr sequence))))
            s))
    (filter sum-equals-s? (unique-three-pairs n)))

2.42

(define (queen board-size)
    (define empty-board `())
    (define (safe? k sequence)
        (define check-seq (reverse sequence))
        (define (iter m seq diff)
            (if (null? seq)
                #t
                (let ((check-point (car seq)))
                    (and (not (= check-point m))
                        (not (= (- diff check-point) m))
                        (not (= (+ diff check-point) m))
                    (iter m (cdr seq) (+ diff 1))))))
        (iter (car check-seq) (cdr check-seq) 1))
    (define (adjoin-position row k sequence)
        (define k-list (list row))
        (append sequence k-list))
    (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))
                            (enumurate-interval 1 board-size)))
                        (queen-cols (- k 1))))))
    (queen-cols board-size))

2.43

在Louis的程序中,每次map操作都会带来一颗递归树的分叉,这在效益上是极大的浪费。

由于每在新的一层就建立了k棵递归树

估计其耗费时间为 .

2.44

(define (up-split painter n)
	(if (= n 0)
		painter
		(let ((smaller upsplit painter (- n 1)))
			(below painter (beside smaller smaller)))))

2.45

(define (split combiner spliter)
    (lambda (painter n)
        (if (= n 0)
            painter
            (let ((smaller ((split combiner spliter) painter (- n 1))))
                (combiner painter (spliter smaller smaller))))))

2.46

(define (make-vect x y)
    (cons x y))
(define (xcor-vect vect)
    (car vect))
(define (ycor-vect vect)
    (cdr vect))
(define (add-vect vec1 vec2)
    (make-vect (+ (xcor-vect vec1) (xcor-vect vec2))
                (+ (ycor-vect vec1) (ycor-vect vec2))))
(define (sub-vect vec1 vec2)
    (make-vect (- (xcor-vect vec1) (xcor-vect vec2))
                (- (ycor-vect vec1) (ycor-vect vec2))))
(define (scale-vect s vect)
    (make-vect (* s (xcor-vect vect)) (* s (ycor-vect vect))))

2.47

(define (make-frame origin edge1 edge2)
    (list origin edge1 edge2))
(define (origin-frame frame)
    (car frame))
(define (edge1-frame frame)
    (car (cdr frame)))
(define (edge2-frame frame)
    (car (cdr (cdr frame))))
(define (make-frame origin edge1 edge2)
    (cons origin (cons edge1 edge2)))
(define (origin-frame frame)
    (car frame))
(define (edge1-frame frame)
    (car (cdr frame)))
(define (edge2-frame frame)
    (cdr (cdr frame)))

2.48

(define (make-segment start end)
    (cons start end))
(define (start-segment segment)
    (car segment))
(define (end-segment segment)
    (cdr segment))

2.49

(define box-painter (segment->painter (list
    (make-segment (make-vect 0 0) (make-vect 0 1))
    (make-segment (make-vect 0 1) (make-vect 1 1))
    (make-segment (make-vect 1 1) (make-vect 1 0))
    (make-segment (make-vect 1 0) (make-vect 0 0)))))
(define xrow-painter (segment->painter (list
    (make-segment (make-vect 0 0) (make-vect 1 1))
    (make-segment (make-vect 1 0) (make-vect 0 1)))))
(define rhombus-painter (segment->painter (list
    (make-segment (make-vect 0 0.5) (make-vect 0.5 1))
    (make-segment (make-vect 0.5 1) (make-vect 1 0.5))
    (make-segment (make-vect 1 0.5) (make-vect 0.5 0))
    (make-segment (make-vect 0.5 0) (make-vect 0 0.5)))))

wave的代码过于硬核,就不画了

2.50

(define (flip-horiz painter)
    (transform painter
        (make-vect 1.0 0.0)
        (make-vect 0.0 0.0)
        (make-vect 1.0 1.0)))
(define (rotate180 painter)
    (transform painter
        (make-vect 1.0 1.0)
        (make-vect 1.0 0.0)
        (make-vect 0.0 1.0)))
(define (rotate270 painter)
    (transform painter
        (make-vect 0.0 1.0)
        (make-vect 1.0 1.0)
        (make-vect 0.0 0.0)))

2.51

(define (below painter1 painter2)
    (let ((split-point (make-vect 0.0 0.5)))
        (let ((painter-below
                (transform painter1
                    (make-vect 0.0 0.0)
                    (make-vect 1.0 0.0)
                    split-point))
              (painter-up
                (transform painter2
                    split-point
                    (make-vect 1.0 0.5)
                    (make-vect 0.0 1.0))))
            (lambda (frame)
                (painter-below frame)
                (painter-up frame)))))
(define (below painter1 painter2)
    (rotate90 (beside (rotate270 painter1) (rotate270 painter2))))

2.52

(define (corner-split painter n)
    (if (= n 0)
        painter
        (let ((up (up-split painter (- n 1)))
             (right (right-split painter (- n 1))))
            (beside (below painter up)
            (below right (corner-split painter (- n 1)))))))
(define (square-limit painter n)
    (let ((quarter (flip-horiz (corner-split painter (- n 1)))))
        (let ((half (beside (flip-horiz quarter) quarter)))
            (below (flip-vert half) half))))