标签：cons car list sicp iter cdr 2.2 define

序对

• 无类型

(cons 1 2)

    o
   / \
  1   2

但是序对本身对于元素的类型是无要求的，它就是一个指针而已。

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

      o
     / \
    1   o
  /    / \
 2    3   5
     /     \
    4       6

列表

当需要一个连续数据的时候，我们大概会这样进行表述

(cons 1 (cons 2 (cons 3 (cons 4 nil))))

可以使用list简化操作

(list 1 2 3 4)

可以分析，car返回的是数据开头的元素，而cdr的元素，其实还是一个序对，也就是剩余的元素，nil作为结束。

• 长度

(define (length-of arr)
  (define (len-iter x len)
    (if (null? x) len
        (len-iter (cdr x) (+ len 1))))
  (len-iter arr 0))

• 取值

(define (value-of arr index)
  (define (value-iter x cursor)
    (if (= cursor 0)
        (car x)
        (value-iter (cdr x) (- cursor 1))))
  (if (< index (length-of arr))
      (value-iter arr index)
      (error "outbound of array")))

• 序号

(define (index-of array value)
  (define (index-iter x index)
    (cond ((null? x) (error "cannot find value"))
          ((= value (car x)) index)
          (else (index-iter (cdr x) (+ index 1)))))
  (index-iter array 0))

• 拼接

(define (append a b)
  (if (null? a)
      b
      (cons (car a) (append (cdr a) b))))

2.17

(define (last-pair arr)
  (cond ((null? arr) (error "illegal list"))
        ((null? (cdr arr)) (car arr))
        (else (last-pair (cdr arr)))))

• 2.18

(define (reverse arr)
  (define (reverse-iter a b)
    (if (null? a)
        b
        (reverse-iter (cdr a) (cons (car a) b))))
  (reverse-iter arr nil))

• 2.19

(define (first-denomination coin-values)
    (car coin-values))

(define (except-first-denomination coin-values)
    (cdr coin-values))

(define (no-more? coin-values)
    (null? coin-values))

(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 (method a . b) ...) 
;; (method 1 2 3 4 5): a = 1, b = (2 3 4 5)

• 2.20

(define (same-parity sample . values)
  (define (collect x others)
    (if (null? x)
        others
        (if (= 0 (remainder (- (car x) sample) 2))
            (collect (cdr x) (cons (car x) others))
            (collect (cdr x) others))))
  (collect values nil))

映射

(define (map f values)
  (if (null? values)
      nil
      (cons (f (car values)) (map f (cdr values)))))

• 2.21

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

(define (map-square-list items)
  (map square items))

• 2.22

(define (square-list items) 
  (define (iter things answer) 
    (if (null? things)
        answer
        (iter (cdr things)
              (cons (square (car things)) ;; mark
                    answer))))
  (iter items nil))

mark所标记的位置，开头的元素优先被弹出，优先被压栈，从而顺序颠倒。

(define (square-list items) 
  (define (iter things answer) 
    (if (null? things)
        answer
        (iter (cdr things)
              (cons answer ;; mark
                    (square (car things))))))
  (iter items nil))

mark所在标记，answer是历史存储，是栈而不是单个元素。

• 2.23

(define (for-each f items)
  (define (execute-iter x)
    (if (not (null? x))
        (begin
          (f (car x))
          (execute-iter (cdr x)))))
  (execute-iter items))

判断

(pair? (list 1 2 3)) #t

• 叶子

(define (count-leaves x) 
  (cond ((null? x) 0)
        ((not (pair? x)) 1)
        (else (+ (count-leaves (car x)))
              (count-leaves (cdr x)))))

• 2.24

(list 1 (list 2 (list 3 4))) ;; (1 (2 (3 4)))

        o
       / \
      1 (2 (3 4))
         /  \
        2  (3 4)
           /   \
          3     4

• 2.25

;; (1 3 (5 7) 9) => 7
(car (cdr (car (cdr (cdr (list 1 3 (list 5 7) 9))))))
;; ((7))
(car (car (list (list 7))))
;; (1 (2 (3 (4 (5 (6 7))))))
(car (cdr (car (cdr (car (cdr (car (cdr (car (cdr (car (cdr (list 1 (list 2 (list 3 (list 4 (list 5 (list 6 7))))))))))))))))))

• 2.26

(define x (list 1 2 3))
(define y (list 4 5 6))

(append x y) 	;; (1 2 3 4 5 6)
(cons x y) 		;; ((1 2 3) 4 5 6)
(list x y) 		;;((1 2 3)  (4 5 6))

• 2.27

(define (deep-reverse items)
  (define (deep-reverse-iter x others)
    (if (null? x)
        others
        (deep-reverse-iter (cdr x) (cons (if (pair? (car x)) (deep-reverse (car x)) (car x)) others))))
  (deep-reverse-iter items nil))

• 2.28

(define (fringe items)
  (define (fringe-iter item others)
    (cond ((null? item) others)
          ((pair? item)  (fringe-iter (car item) (fringe-iter (cdr item) others)))
          (else (cons item others))))
  (fringe-iter items nil))

• 2.29

     o
   /   \
  /     \
len   str|o

很明显如果它存在子嵌套，那么第二个元素必定不是pair

;; mobile
(define (make-mobile left right) 
  (list left right))
;; branch
(define (make-branch length structure) 
  (list length structure))

** a a a) **

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

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

b b b)

(define (total-weight x)
  (let ((left (car x))
        (right (car (cdr x))))
    (cond ((pair? left) (+ (total-weight left) (total-weight right))) ;;mobile，left+right
          ((pair? right) (total-weight right)) ;; branch-mobile,right
          (else right)))) ;; branch-weight, right-value

c c c)

首先，应该梳理一下条件

1. 活动体下必定存在两个分支
2. 分支下面存在一个活动体或者重量
3. 平衡体平衡
   1. 两边分支力矩相等
   2. 子活动体平衡

简洁的描述即是：递归判断活动体平衡，而活动体平衡依赖于力矩相等。

如果力矩不相等，就没必要进行子活动体平衡的判断，这相当于相互嵌套的条件递归。

(define (branch-torque branch)  ;; 力矩计算
  (* (branch-length (total-weight (branch-structure branch)))))

(define (branch-balance? branch) ;; 抽象为统一平衡
  (if (pair? (branch-structure branch))
      (mobile-balance? (branch-structure branch)) ;; 存在活动体,判断活动体平衡
      #t)) ;; 默认分支平衡

(define (mobile-balance? mobile)
  (let ((left (left-branch mobile))
        (right (right-branch mobile)))
    (and (= (branch-torque left)
            (branch-torque right)) 	;; 力矩平衡，如果不平衡就无谓子活动体平衡
         (branch-balance? left) 	;; 左分支平衡，自动转到活动体平衡 
         (branch-balance? right))))	;; 右分支平衡，自动转到活动体平衡

d d d)

(define (make-mobile left right) 
  (cons left right))
(define (make-branch length structure) 
  (cons length structure))

首先，这里的主要矛盾在于cons和list的区别所在，现在先仔细分析一下。

---

前面已经给出了原理上的等价

(list 1 2 3)
(cons 1 (cons 2 (cons 3 nil)))

也就是说，list和cons的相同点在于，他们的确的都是序对的，存在的元素一直以来都是两个。

但是，关键的矛盾就在于这第二个，或者说最后一个元素的元素。

(cdr (cons 1 2)) ;;  2
(cdr (list 1 2)) ;; (2)

相同的操作，我们似乎取得的不是同样的数据，因此，对于list我们经常需要进行(car (cdr x))的操作。

(cons 1 (cons 2 3)) 	;; (1 2 . 3)
(cons 1 (cons 2 nil))	;; (1 2 3)

现在明白些什么了么，lisp构造数据的时候，最末尾的总是(cons n nil)。

因此，我们进行cdr操作的时候，cons最后始终能够取出最后一个数据，但是list只能够拿到nil。

更有意思的是

(lisp) 			;; ()
(cons nil nil)	;; (())

我们无法通过cons构造一个空的列表，因为cons始终需要仅需要两个元素。

---

现在，回归主题，我们需要改动什么。

你会发现，其实相关的只是基本数据结构的实现，而后续都是基于定义方法进行操作的，因此范围还算小

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

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

或者还有一个

(define (total-weight x)
  (let ((left (car x))
        (right (cdr x)))
    (cond ((pair? left) (+ (total-weight left) (total-weight right))) ;;mobile，left+right
          ((pair? right) (total-weight right)) ;; branch-mobile,right
          (else right)))) ;; branch-weight, right-value

因为不太能判定类型的情况下，特定方法名总会产生误导。

• 2.30

;; iter
(define (square x) (* x x))
(define (square-tree-iter tree)
  (cond ((null? tree) nil)
        ((pair? tree) (cons (square-tree-iter (car tree)) (square-tree-iter (cdr tree))))
        (else (square tree))))
;; map
(define (map f arr)
  (if (pair? arr)
      (cons (f (car arr)) (map f (cdr arr)))
      nil))
(define (square-tree tree)
  (cond ((null? tree) nil)
        ((pair? tree) (cons (square-tree (car tree)) (square-tree (cdr tree))))
        (else (square tree))))
(define (square-tree-map tree)
  (map square-tree tree))

• 2.31

(define (map f arr)
  (cond ((null? arr) nil)
        ((pair? arr) (cons (map f (car arr)) (map f (cdr arr))))
        (else (f arr))))
(define (square-tree-map tree)
  (map square tree))

• 2.32

(define (subsets s)
  (if (null? s)
      (list nil)
      (let ((rest (subsets (cdr s))))
        (append rest (map <??> rest)))))

很有意思，我们从两个方面对这道题进行理解

---

子集

以(1 2 3)为例子

    (1 2 3)
    /     \
   1     (2 3)
         /   \
        2    (3)
             /  \
            3   nil

虽然子集似乎是随机不定进行相互组合的，但是顺序拆分也能找到规律

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

可以看到野种最简单的方法，那就是子集加上新元素，也就是

(1) => 1 for ()
(1 2) => 2 for (1) => ((2) (1) ())
...

因此可以填充如下代码

(define (subsets s)
  (if (null? s)
      (list nil) ;; 塞入空集合
      (let ((rest (subsets (cdr s)))) ;; 后续元素的子集
       	;; 包含子集
        (append rest 
                ;; 每个子集和新元素的组合
                (map (lambda (x) (cons (car s) x)) rest))))) 

(subsets (list 1 2 3))
;; (() (3) (2) (2 3) (1) (1 3) (1 2) (1 2 3))

---

但是，这种办法有个坏处，那就是需要展开，然后收拢。换一种理解方式，我们可以做成尾递归。

()
(() (1))
(() (1) (2) (1 2))

我们不要依靠子集，我们直接构建子集，因为依赖于子集就需要递归的依赖子集建立。

我们逐个遍历元素，而子集更新为添加新元素，并且添加新元素和子集元素的组合

(define (map func items)
  (if (null? items)
       nil
      (cons (func (car items)) (map func (cdr items)))))

(define (subsets s)
  (define (subset-iter result items)
    (if (null? items)
        result
        (subset-iter (append result (map (lambda (x) (append x (list (car items)))) result)) (cdr items))))
  (subset-iter (list nil) s))

(subsets (list 1 2 3))
;; (() (1) (2) (1 2) (3) (1 3) (2 3) (1 2 3))

可以看到，我们从第一个元素就开始构造子集，和原来的方法相比，顺序是相反的。

---

递归

破解这道题目，就算没有把子集弄明白，还是有其他的办法的。

递归当中最终要的无非是两点：递归传递，终止条件。

终止条件找到了，也就是null? s，也就是遍历完成。

递归传递的时候呢，我们来分析一下append (sbusets (cdr s)) (map <??> (subsets (cdr s)))。

它表达的是需要在一个结果之上添加一定的结果操作元素。

当我们使用(1)进行带入的时候，你会发现这个表达式就会变为append (() (map <??> ()))

明显的一个缺失感，因为(subsets (cdr s))并不包含全体的s元素，子集是不完整的，必须要有这么一个办法，将缺失填补。

(cdr s)相对于s缺失的，必定就是(car s)，这就是关键点了，并且题目已经提示map，剩下就是基本组合。

序列

• 奇叶子和

(define (sum-odd-square tree) 
  (cond ((null? tree) 0)
        ((pair? tree) (+ (sum-odd-square (car tree)) (sum-odd-square (cdr tree))))
        (else (if (odd? tree) (square tree) 0))))

• 偶斐波那契

(define (even-fibs n)
  (define (next k)
    (if (> k n)
        nil
        (let ((f (fib k)))
          (if (even? f)
              (cons f (next (+ k 1)))
              (next (+ k 1))))))
  (next 0))

• 过滤器

(define (filter predicate sequence)
  (cond ((null? sequence) nil)
        ((predicate (car sequence)) (cons (car sequence) (filter predicate (cdr sequence))))
        (else (filter predicate (cdr sequence)))))

• 流式处理

(define (accumulate operation initial sequence)
  (if (null? sequence)
      initial
      (operation (car sequence) (accumulate operation initial (cdr sequence)))))

• 序列构造

(define (enumerate-interval from to)
  (if (> from to)
      nil
      (cons from (enumerate-interval (+ from 1) to))))

模式分析清楚以后，我总想做这么一个过程

(define (stream preprocessor filter combine postprocessor)(...))

也就是说，包含前置处理，筛选，合并操作，后置处理。

还有更多想法，就是一系列的方法，通过变参进行传入，一一作用于处理过的序列。

但是对比了好久，发现这并不是一个比较好的方法，或者说全部组织起来并不是一个好方法。

这样会使得原来的强扩展性变得束缚，在一些简单的场景，甚至会不得不弄出这么一个垃圾方法

(define (origin x) x)

因为使用场景不包含，却不得不符合模式。

但是变参方法是一个不错的想法，它能够一次性的应用多种模板。它可以用来进行层级数据的处理。

(define (stream sequence . input-processors)
  (define (stream-execute data processors)
    (if (null? processors)
      data
      (stream-execute ((car processors) data) (cdr processors))))
  (stream-execute sequence input-processors))

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

(define (sum items)
  (if (null? items)
      0
      (+ (car items) (sum (cdr items)))))

(stream (list 1 2 3) sequare-map sum) ;; 14

也就是说，相互间的数据结构能够接续，就能够完成工作，这种松耦合，才是扩展性、适应性最强的。

---

前面的模式抽取，也算作一种固化的方式，不过是符合我们的习惯，易于我们的理解。

而且，模式抽取的固化，也不一定就是无用，它隔离的部分，能够提供我们更多操作的空间。

但是，基于抽象的抽象，才能带来高适应性，任何只为服务于具体的抽象，都是具体，置喙增加冗余。

因此想如何的处理序列，不如想如何组装、传递序列的关系，后者更简单，但是更有用。

• sum-odd-square·改

(define (enumerate-tree tree)
  (cond ((null? tree) nil)
        ((pair? tree) (append (enumerate-tree (car tree)) (enumerate-tree (cdr tree))))
        (else (list tree))))

(define (sum-odd-tree tree)
  (accumulate + 0 (map tree (filter odd? (enumerate-tree tree)))))

抽象的模式的确匹配了，但是思考之后，你会发现为了适应这个模式，有些地方的确固化了些。

• even-fibs·改

(define (even-fibs n) 
  (accumulate cons nil (filter even? (map fib (enumerate-interval 0 n)))))

如果我们将第一个方法作为一个数据生成器，那会如何。

(stream nil (lambda (x) (list 1 2 3))) ;;

也就是说，我们甚至把书中的抽象给肢解了，粒度更细了，抽象层面上。

我们甚至连组合方式都能都自己定制，能够聚拢，还能够发散。

抽象，是一种极简单关系的描述，用最简单的限定条件，将各部分元素界限分明的隔离。

抽象的好处就在于，这种关系显得十分的简单笼统，以至于能够塞下条件允许的全部想法。

而关系的两端，明确的表明这两端元素的特殊含义和独特属性，越是抽象，能包含的越多，扩展也就越强。

---

• 2.33

做题之前，我觉得有必要抬出定义

(define (accumulate operation initial sequence) 
  (if (null? sequence)
      initial
      (operation (car sequence) (accumulate operation initial (cdr sequence)))))

(define (map p sequence) 
  (accumulate (lambda (x y)
                ;; 遍历出来的元素需要操作
                (cons (p x) y)) nil sequence))

更明显了，其中的operation传入的就是后续需要操作的元素，当前元素和后续元素。

后续元素终将递归为当前元素，因此，我们传入的不仅是组合方式，同时还可以插入针对元素的特殊操作。

(define (append seq1 seq2) 
  (accumulate cons seq2 seq1))

实话说，我想吐，感觉这道题并没有十分出彩，反而有些败笔。

它的确模仿了原生的append在seq1或者seq2为nil时候的场景，但是两个都非nil得时候，并不正确。

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

有意思，这里提供得operation超乎想象，x代表元素操作，y代表递归操作。

• 2.34

a n x n + a n − 1 x n − 1 + ⋯ + a 1 x + a 0 = ( ⋯ ( a n x + a n − 1 ) x + ⋯ + a 1 ) x + a 0 \begin{aligned} &a_nx^n + a_{n-1}x^{n-1}+\cdots + a_1x + a_0 \\ \quad \\ =&(\cdots (a_nx+ a_{n-1})x + \cdots +a_1) x + a_0 \end{aligned} =​an​xn+an−1​xn−1+⋯+a1​x+a0​(⋯(an​x+an−1​)x+⋯+a1​)x+a0​​

题目已知，sequence按照系数递增。

那么，我们干脆将表达式反过来看，更明白一些
a 0 + x ( a 1 + ⋯ + x ( a n − 1 + x ( a n ) ) ) a_0 + x(a_1 + \cdots + x(a_{n-1} + x(a_n))) a0​+x(a1​+⋯+x(an−1​+x(an​)))
也就是说，当前元素加上递归值乘以 x x x

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

• 2.35

原版

(define (count-leaves tree)
  (cond ((null? tree) 0)
        ((not (pair? tree)) 1)
        (else (+ (count-leaves (car tree))
                 (count-leaves (cdr tree))))))

(define (count-leaves tree)
  (accumulate + 0 (map (lambda (x)
                         (cond ((null? x) 0)
                               ((not (pair? x)) 1)
                               (else (count-leaves x)))) tree)))

其实很容易理解，前面套路太多，但是我们也得返璞归真。

operation可以针对传入的两个数据进行更多的定制操作，但是最明显的一个功用，那就是聚合。

同时，递归的特征是父子同结构，在边缘条件上可以定制，但是递归调用的时候还是需要回顾一下递归的目的。

我们最终是要获取叶子的个数，对于子节点而言，我们并没有太多的选择空间，直接调用递归方法是最简单的。

综上而言，就变成了计算+聚合的方式，从而解决问题。

• 2.36

(define (accumulate-n op init seqs) 
  (if (null? (car seqs))
      nil
      (cons (accumulate op init <??>)
            (accumulate-n op init <??>))))

(define seq (list (list 1 2 3) (list 4 5 6) (list 7 8 9) (list 10 11 12)))
(accumulate-n + 0 seq) ;;(22 26 30)

从题干能够分析出来，(accumulate op init <??>)就是将数据的头一个元素取出来。cons准确的表明这一观点。

也就是说，我们需要将第一个元素取出来这种操作，对应到传入的数据的每一个元素当中。

(accumulate op init (map car seqs))

而剩下的，就是继续处理剩下的数据，和上一步互补

(accumulate-n op init (map cdr seqs))

因此，总的过程应该是

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

其中需要锻炼的是：

1. map中的操作对应每一个元素，我们关注的还是个体元素，而不能被多层嵌套扰乱而放弃基本准则
2. 递归除了边界和传递，很明确，还存在互补

---

• 2.37

[ 1 2 3 4 4 5 6 6 6 7 8 9 ] \left[\begin{matrix} 1 & 2 & 3 & 4 \\ 4 & 5 & 6 & 6\\ 6 & 7 & 8 & 9 \end{matrix} \right] ⎣⎡​146​257​368​469​⎦⎤​

(list (list 1 2 3 4) (list 4 5 6 6) (list 6 7 8 9))

∑ i v i w i \sum_i v_i w_i i∑​vi​wi​

(define (dot-product v w) 
  (accumulate + 0 (map * v w)))

只能说，注意下标，这里并非矩阵，而只是指定列。
∑ j m i j v j \sum_j m_{ij}v_j j∑​mij​vj​

(define (matrix-*-vector m v) 
  (map (lambda (col) (dot-product col v)) m))

做题的时候，尤其是这些概念型的题，第一个要点，就是在于明白结果到底是一个什么样子。

这道题得到的是一个向量，并不是一个是数值，和第一个计算式不一样。

然后，我们再分析一下表达式和我们理解上的联系，也就是拆分和聚合。

∑ i v i w i \sum_i v_iw_i ∑i​vi​wi​，它是明确的一个数字，因为 i i i在 ∑ \sum ∑的过程中，完成了统一，是简单数据的加和。

而 ∑ j m i j v j \sum_j m_{ij}v_j ∑j​mij​vj​，在枚举之后，它还存在一个隔离的维度 i i i，因此得到的结果形式并非是单一数字，而是一个向量。

向量和矩阵的差距，在于矩阵的二维展开，这就很容易的理解题干了。

题意虽然是 ∑ j \sum_j ∑j​，但其实是 i i i维度的遍历的 j j j的聚合，但是仍然保留了 i i i维度的独立性。

n i j = m j i n_{ij} = m_{ji} nij​=mji​

(define (transpose m) 
  (accumulate-n cons nil m))

很明显的题目，我们需要把竖列对应的元素收拢起来
∑ k m i k n k j \sum_k m_{ik} n_{kj} k∑​mik​nkj​

结合前面的论断，消去维度 k k k以后，保留并组合了 i j ij ij维度，结果是矩阵也就是理所当然。

这里相较于前面一道题，多了两个扩充点：转置，遍历

首先，上一题的结果得到一个向量，我们的矩阵需要都收集起来，也就是每一行都用上面的结果计算出来。

其次，对应的点，变成了行对列，因此需要转置

(define (matrix-*-matrix m n) 
  (let ((n-ts (transpose n)))
    (map (lambda (m-k) (matric-*-vector n-ts m-k)) m)))

从单个元素的遍历，到集合对集合，然后集合对多集合，最后多集合对多集合。

其实无非都是同样的模式：将数据进行降维，针对降维数据进行操作。

这也是我们的题目都需要前一步的结果的原因，因为题目总是从最低维的数据进行复合。

• 2.38

;; left
(define (fold-left operation initial sequence)
  (define (iter result rest)
    (if (null? rest)
        result
        (iter (operation (car rest) result) (cdr rest))))
  (iter initial sequence))
;; right
(define (fold-right operation initial sequence)
  (define (iter result rest)
    (if (null? rest)
        result
        (iter (operation result (car rest)) (cdr rest))))
  (iter initial sequence))

可以看到，两者并没有太大区别，而在于结果的叠加

(operation result  current) ;; right 
(operation current result ) ;; left

也就是说，只有组合顺序的区别

(fold-right / 1 (list 1 2 3)) ;; (/ 3 (/ 2 1))
(fold-left  / 1 (list 1 2 3)) ;; (/ 1 (/ 2 3))
(fold-right / list nil (list 1 2 3)) ;; (list (list (list (list) 1) 2) 3)
(fold-left  / list nil (list 1 2 3)) ;; (list 3 (list 2 (list 1 (list))))

如果想要fold-left和fold-right效果相等，那么简单，无序就行了，也就是满足如下计算关系
a ⊗ b = b ⊗ a a\otimes b = b \otimes a a⊗b=b⊗a
最常见的加法和乘法都可以
a × b = b × a a + b = b + a a \times b = b \times a \\ a + b = b + a a×b=b×aa+b=b+a

• 2.39

(define (reverse sequence)
  (fold-left (lambda (x y) (cons x y)) nil sequence))
(define (reverse sequence)
  (fold-right (lambda (x y) (cons y x)) nil sequence))

不管传入顺序如何，但是前面也说了，真正的拼接和操作都交给了operation，顺序还不是小事情么。

嵌套循环

def table(rows):
    for row in range(1, rows + 1):
        for column in range(1, row + 1):
            print('{a}x{b}={c}'.format(a=column, b=row, c=column*row), end='\t')
        print()

就像这种的嵌套循环生成的数据对，怎么做呢

(define (generate-n n)
  (append nil (map
               (lambda (i)
                 (map (lambda (j) (list j i)) (accumulate-interval i)))
               (accumulate-interval n))))

这就是乘法表的序列了，我们来分析一下

• 单数字生成序列
• 序列单元素生成序列
• 按照最初序列进行拼接

简单来说，第一步生成序列只是最基础的，不算在操作里面。

而针对序列中的元素，我们要生成一个结果序列，这个结果序列是自身和伴生成子序列的序对。

(generate-n 5)
;; (((1 1)) ((1 2) (2 2)) ((1 3) (2 3) (3 3)) ((1 4) (2 4) (3 4) (4 4)) ((1 5) (2 5) (3 5) (4 5) (5 5)))

对比结果，更显得直观，反推更有感觉。

抽象

前面的方法经过改造，更想强调每一行，而非详细到每一个具体的序对，因此是直接进行的append

(define (generate-n n)
  (accumulate append nil (map
               (lambda (i)
                 (map (lambda (j) (list j i)) (enumerate-interval i)))
               (enumerate-interval n))))

书中的方法更侧重于元素，accumulate将包裹的元素一一取出拉平了。

(define (flatmap proc seq) 
  (accumulate append nil (map proc seq)))

这就是上面的一般模式，取消了seq的自动生成，同时忽略了proc的多重属性。

但是我们需要知道，proc生成的数据只是一个list，但是其中的个数和层级，并没有强制规定。

累和素数

• 序对判断

(define (prime-sum? pair) 
  (prime? (+ (car pair) (cadr pair))))

因为其中的两个元素的收集，采用的是list而非cons，因此，虽然只是两个元素，但是结果是(cons (i (cons j nil)))。

取出j的话，应该是(car (cdr seq))，scheme中为了方便，提供cadr这一操作符号。

• 结果组装

(define (make-pair-sum pair) 
  (list (car pair) (cadr pair) (+ (car pair) (cadr pair))))

• 完整过程

(define (prime-sum-pair n)
  (map (make-pair-sum)
       (filter prime-sum?
               (flatmap
                (lambda (i)
                  (map
                   (lambda (j)
                     (list i j))
                   (enumerate-interval (- i 1))))
                (enumerate-interval 1 n)))))

先生成序列，然后组装成序对，通过过滤器，最后生成三值序对，没毛病。

排列组合

我又忘记flatmap的作用了，回顾了一遍，就是拉平收集元素中的二级元素，也就是说，主体元素还是在proc中进行生成的。

(define (remove item sequences) 
  (filter (lambda (x) (not (= x item))) sequence))

(define (premutations s) 
  (if (null? s)
      (list)
      (flatmap (lambda (x) 
                 (map (lambda (p) (cons x p)) 
                      (premutations (remove x s)))) s)))

解读一下：

• 任意抽出一个元素，拼接上补集的全部排列组合，得到以该元素为首的全部排列组合
• 元素排列组合，等价于以全体元素为首的全部排列的集合

嗯，递归真是不干人事，但是我们可以分析一下它展现出来的含义。

• 初级递归

1 ◯ 2 ◯ 3 ◯ %% \begin{array}{|c|c|c|} %% \hline %% \enclose{circle}{1} & \enclose{circle}{2}&\enclose{circle}{3} \\ %% \hline %% \end{array} \begin{array}{|c|c|c|} \hline \text{\textcircled{1}} & \text{\textcircled{2}} & \text{\textcircled{3}} \\ \hline \end{array} 1◯​2◯​3◯​​

按照顺序，递归应该是如此进行展开的
1 ◯ → 2 ◯ → 3 ◯ → 2 ◯ → 1 ◯ \text{\textcircled{1}} \rightarrow \text{\textcircled{2}} \rightarrow \text{\textcircled{3}} \rightarrow \text{\textcircled{2}} \rightarrow \text{\textcircled{1}} 1◯→2◯→3◯→2◯→1◯
举个例子
f ( x ) = 1 + f ( x − 1 ) f ( 1 ) = 1 f(x) = 1 + f(x-1) \quad f(1) = 1 f(x)=1+f(x−1)f(1)=1

(define (f n) 
(if (= n 1)
    1
    (+ 1 (f (- n 1)))))

f ( 4 ) = 1 + f ( 3 ) = 1 + ( 1 + f ( 2 ) ) = 1 + ( 1 + ( 1 + f ( 1 ) ) ) = 1 + ( 1 + ( 1 + 1 ) ) = 1 + ( 1 + 2 ) = 1 + 3 = 4 \begin{aligned} &f(4) \\ =&1 + f(3) \\ =&1 + (1 + f(2)) \\ =&1 + (1 + (1 + f(1))) \\ =&1 + (1 + (1 + 1)) \\ =&1 + (1 + 2) \\ =&1 + 3 \\ =&4 \end{aligned} =======​f(4)1+f(3)1+(1+f(2))1+(1+(1+f(1)))1+(1+(1+1))1+(1+2)1+34​

也就是说它经过了膨胀到收缩的过程，是堆栈触底之后再回溯的聚合计算。

• 尾递归

1 ◯ 2 ◯ 3 ◯ %% \begin{array}{|c|c|c|} %% \hline %% \enclose{circle}{1} & \enclose{circle}{2} & \enclose{circle}{3} \\ %% \hline %% \end{array} \begin{array}{|c|c|c|} \hline \text{\textcircled{1}} & \text{\textcircled{2}} & \text{\textcircled{3}} \\ \hline \end{array} 1◯​2◯​3◯​​

尾递归的顺序是
1 ◯ → 2 ◯ → 3 ◯ %% \enclose{circle}{1} \rightarrow \enclose{circle}{2} \rightarrow \enclose{circle}{3} \text{\textcircled{1}} \rightarrow \text{\textcircled{2}} \rightarrow \text{\textcircled{3}} 1◯→2◯→3◯
没错，尾递归之所以高效，就是因为它是单向，栈深度直接减半，并且，栈空间需求为常量。

(define (f n) 
  (define (f-iter result iter)
    (if (= iter 1)
        (+ result iter)
        (f-iter (+ result 1) (- iter 1))))
  (if (> n 1)
      (f-iter 0 n)))

f ( 4 ) = 1 + f ( 3 ) = 2 + f ( 2 ) = 3 + f ( 1 ) = 3 + 1 = 4 \begin{aligned} &f(4) \\ =&1+ f(3) \\ =&2 + f(2) \\ =&3 + f(1) \\ =&3 + 1 \\ =&4 \end{aligned} =====​f(4)1+f(3)2+f(2)3+f(1)3+14​

• 嵌套递归

如果一次递归计算本身包含递归计算呢，甚至是双重展开的话，该怎么办。

针对排列组合，就是这种方式，如果概念厘不清楚，估计会放过这个奇妙的小东西。
1 ◯ 2 ◯ 3 ◯ 4 ◯ 5 ◯ 6 ◯ 7 ◯ 8 ◯ 9 ◯ \begin{array}{|c|c|c|} \hline \text{\textcircled{1}} & \text{\textcircled{2}} & \text{\textcircled{3}} \\ \hline \text{\textcircled{4}} & \text{\textcircled{5}} & \text{\textcircled{6}} \\ \hline \text{\textcircled{7}} & \text{\textcircled{8}} & \text{\textcircled{9}} \\ \hline \end{array} 1◯4◯7◯​2◯5◯8◯​3◯6◯9◯​​
它的收缩情况我们先画出来
1 ◯ → 4 ◯ → 7 ◯ → 4 ◯ → 1 ◯ → 2 ◯ → 5 ◯ → 8 ◯ → 5 ◯ → 2 ◯ → 3 ◯ → 6 ◯ → 9 ◯ → 6 ◯ → 3 ◯ %% \enclose{circle}{1} \rightarrow \enclose{circle}{4} \rightarrow \enclose{circle}{7} \rightarrow \enclose{circle}{4} \rightarrow \enclose{circle}{1} \rightarrow \enclose{circle}{2} \rightarrow \enclose{circle}{5} \rightarrow \enclose{circle}{8} \rightarrow \enclose{circle}{5} \rightarrow \enclose{circle}{2} \rightarrow \enclose{circle}{3} \rightarrow \enclose{circle}{6} \rightarrow \enclose{circle}{9} \rightarrow \enclose{circle}{6} \rightarrow \enclose{circle}{3} \text{\textcircled {1}} \rightarrow \text{\textcircled {4}} \rightarrow \text{\textcircled {7}} \rightarrow \text{\textcircled {4}} \rightarrow \text{\textcircled {1}} \rightarrow \text{\textcircled {2}} \rightarrow \text{\textcircled {5}} \rightarrow \text{\textcircled {8}} \rightarrow \text{\textcircled {5}} \rightarrow \text{\textcircled {2}} \rightarrow \text{\textcircled {3}} \rightarrow \text{\textcircled {6}} \rightarrow \text{\textcircled {9}} \rightarrow \text{\textcircled {6}} \rightarrow \text{\textcircled {3}} 1◯→4◯→7◯→4◯→1◯→2◯→5◯→8◯→5◯→2◯→3◯→6◯→9◯→6◯→3◯
举个例子，就是
g ( n ) = ∑ i f ( i ) g(n) = \sum_i f(i) g(n)=i∑​f(i)
它会首先计算其中一个递归的值，但是这个值的计算方式也是递归的，然后递归的计算其他值，其他值也需要递归计算。

这道题就是这样：先固定一个元素，然后求出剩余子集排列，然后添加自己，然后递归固定其他元素。

因此，关于递归，我推荐**理解环节**，穷尽的事情，对我这种一般人实在太难了，理解一步就好。

---

• 2.40

(define (unique-pairs n)
  (flatmap (lambda (iter)
             (map (lambda (inner-iter) (list iter inner-iter)) (enumerate-interval 1 (- iter 1)))) (enumerate-interval 1 n)))

(define (prime-sum-pair n)
  (map make-pair-sum
       (filter prime-sum? (unique-pairs n))))

• 2.41

(define (sum-pair n s)
  (define (sequence-generate) ;; 多余无用
    (let ((boundary (- s 2))) ;; 谁小选谁，三元组不为0，-2
      (enumerate-interval 1 (if (> n boundary) boundary n))))
  (define (diff-sum-condition pair) ;; 元素不同，并且和为s
      (let ((a (car pair))
            (b (cadr pair))
            (c (cadr (cdr pair))))
        (and (> c 0) ;; 不能为0
             (not (or (= a b) (= a c) (= b c)))
             (= s (+ a b c)))))
  (define (pair-generate first) ;; 序对生成规则，遍历first，(first - 1)
    (map (lambda (second)
           (list first second (- s first second)))
         (enumerate-interval 1 (- s first))))
  (filter diff-sum-condition (flatmap pair-generate (sequence-generate))))

• 2.42

(define (queens board-size)
  (define (queen-clos 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))

程序和题目描述的步骤一样：在已有行数之上，遍历添加位置，过滤后添加下一行

---

参数都全部传入的，因此对于定义的任何数据结构，都能够兼容。

我们至少可以有三种结构定义 ( y 0 y 1 …   ) (y_0 \quad y_1 \quad \dots) (y0​y1​…)， ( ( x 0 y 0 ) ( x 1 y 1 ) …   ) ((x_0 \quad y_0)\quad(x_1 \quad y_1) \quad \dots) ((x0​y0​)(x1​y1​)…), ( ( 1 0 …   ) ( 0 1 …   ) ) ((1 \quad0\quad\dots) (0 \quad 1\quad \dots)) ((10…)(01…))。

不管基于什么结构，都需要把坐标拿出来，与其后期加工，不如直接预先设置，因此采用 ( x 0 y 0 ) (x_0 \quad y_0) (x0​y0​)。

(define (make-position x y) 
  (cons x y))
(define (position-x position) 
  (car x))
(define (position-y position) 
  (cdr position))
(define (print-as-point position) 
  (display "(")
  (display (position-x position))
  (display ",")
  (display (position-y))
  (display ")")
  (newline))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (print-as-table-creator positive nagetive splitor)
  (define (print-with-splitor msg)
    (display msg)
    (display splitor))
  (define (print-negative)
    (print-with-splitor nagetive))
  (define (print-positive)
    (print-with-splitor positive))
  (define (print-end)
    (display "\n"))
  (define (print-element positive?)
    (if positive?
        (print-positive)
        (print-negative)))
  (lambda (size position)
    (let ((sign (position-y position)))
      (define (print-iter iter)
        (if (> iter size)
            (print-end)
            (begin
                    (print-element (= iter sign))
                    (print-iter (+ iter 1)))))
      (print-iter 1))))

(define table-print (print-as-table-creator "1" "0" " "))

(define (print-positions printer size positions)
  (define (print-iter residue)
    (if (not (null? residue))
        (begin
          (printer size (car residue))
          (print-iter (cdr residue)))))
  (print-iter positions))

(define (simple-print-positions size positions)
  (print-positions table-print size positions))

(simple-print-positions 3 (list (cons 1 1) (cons 2 2) (cons 3 3)))
;; 1 0 0 
;; 0 1 0 
;; 0 0 1

---

判断是否符合规则，也就是共线，有三种计算方式

• 不同行( y 0 ≠ y 1 y_0 \ne y_1 y0​​=y1​)
• 不同列 ( x 0 ≠ x 1 ) (x_0 \ne x_1) (x0​​=x1​)
• 不共线( 1 ≠ ∣ y 1 − y 0 x 1 − x 0 ∣ 1 \ne |\frac{y_1 - y_0}{x_1 - x_0}| 1​=∣x1​−x0​y1​−y0​​∣)

;; 两点之间
(define (safe-between-position p1 p2)
  (let ((a (position-x p1))
        (b (position-y p1))
        (c (position-x p2))
        (d (position-y p2)))
        (not (or
              (= a c)
              (= b d)
              (= 1 (abs (/ (- c a) (- d b))))))))
;; 坐标测试
(define (safe-with-positions p positions)
  (if (null? positions)
      #t
      (and (safe-between-position p (car positions))
           (safe-with-positions p (cdr positions)))))
;; 测试集合
(define (safe-positions positions)
  (if (null? positions)
      #t
      (and (safe-with-positions (car positions) (cdr positions)) (safe-positions (cdr positions)))))

题目中每次都会校验，我们只用采取safe-with-positions的校验方式就行了，没必要从头到尾重复校验。

为了方便操作，我们只要逆序拼接，栈顶的数据就是最后一次，我们就能轻易的进行判断

(define (safe? k positions)
  (safe-with-positions (car positions) (cdr positions)))

---

接下来就是生成序对了，我们一一去分清元素代表的含义

field	description
rest-of-queens	已经存在的positions
new-row	填充的位置y
k	x

对于adjoin-position，我们需要做如下事情

1. 生成新的坐标对 ( k , new-row ) (\text{k}, \text{new-row}) (k,new-row)
2. 拼接序列 ( cons pair rest-of-queens ) (\text{cons pair rest-of-queens}) (cons pair rest-of-queens)

因为我们为了麻烦，决定的倒序添加，取第一个就是刚添加的，所以顺序如此。

整体方法收集了一份如下，有兴趣的可以运行一下

#lang sicp
;;;;;;;;;;;;;;;;;;;
;; 前述基础方法
(define (enumerate-interval from to)
  (if (> from to)
      nil
      (cons from (enumerate-interval (+ from 1) to))))

(define (accumulate operation initial sequence)
  (define (iter result rest)
    (if (null? rest)
        result
        (iter (operation (car rest) result) (cdr rest))))
  (iter initial sequence))

(define (flatmap proc seq) 
  (accumulate append nil (map proc seq)))

(define (filter condition? sequence)
  (if (null? sequence)
      nil
      (let ((current (car sequence)))
        (if (condition? current)
            (cons current (filter condition? (cdr sequence)))
            (filter condition? (cdr sequence))))))


;; 结构提定义
(define (make-position x y) 
  (cons x y))
(define (position-x position) 
  (car position))
(define (position-y position) 
  (cdr position))
(define (print-as-point position) 
  (display "(")
  (display (position-x position))
  (display ",")
  (display (position-y))
  (display ")")
  (newline))

;; 打印方法定制
(define (print-as-table-creator positive nagetive splitor)
  (define (print-with-splitor msg)
    (display msg)
    (display splitor))
  (define (print-negative)
    (print-with-splitor nagetive))
  (define (print-positive)
    (print-with-splitor positive))
  (define (print-end)
    (display "\n"))
  (define (print-element positive?)
    (if positive?
        (print-positive)
        (print-negative)))
  (lambda (size position)
    (let ((sign (position-y position)))
      (define (print-iter iter)
        (if (> iter size)
            (print-end)
            (begin
                    (print-element (= iter sign))
                    (print-iter (+ iter 1)))))
      (print-iter 1))))

;; 基本打印方法
(define table-print (print-as-table-creator "1" "0" " "))

;; 集合打印方法
(define (print-positions printer size positions)
  (define (print-iter residue)
    (if (not (null? residue))
        (begin
          (printer size (car residue))
          (print-iter (cdr residue)))))
  (print-iter positions))

;; 基本集合打印
(define (simple-print-positions size positions)
  (print-positions table-print size positions))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 两点共线
(define (safe-between-position p1 p2)
  (let ((a (position-x p1))
        (b (position-y p1))
        (c (position-x p2))
        (d (position-y p2)))
        (not (or
              (= a c)
              (= b d)
              (= 1 (abs (/ (- c a) (- d b))))))))
;; 集合共线检查
(define (safe-with-positions p positions)
  (if (null? positions)
      #t
      (and (safe-between-position p (car positions))
           (safe-with-positions p (cdr positions)))))
;; 共线包含
(define (safe-positions positions)
  (if (null? positions)
      #t
      (and (safe-with-positions (car positions) (cdr positions)) (safe-positions (cdr positions)))))

;; 共线接口
(define (safe? k positions)
  (safe-with-positions (car positions) (cdr positions)))


;; 集合添加
(define (adjoin-position y x exist-queens)
  (append (list (cons x y)) exist-queens))

;; 题目答案
(define empty-board (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 (print-queens n)
  (define (print-table positions)
    (simple-print-positions n positions))
  (define (print-iter positions-list)
    (if (not (null? positions-list))
        (begin
          (print-table (car positions-list))
          (display "--------------\n")
          (print-iter (cdr positions-list)))))
  (print-iter (queens n)))

(print-queens 5)

0 0 1 0 0 
0 0 0 0 1 
0 1 0 0 0 
0 0 0 1 0 
1 0 0 0 0 
--------------
0 0 0 1 0 
0 1 0 0 0 
0 0 0 0 1 
0 0 1 0 0 
1 0 0 0 0 
--------------
0 0 0 1 0 
1 0 0 0 0 
0 0 1 0 0 
0 0 0 0 1 
0 1 0 0 0 
--------------
0 0 0 0 1 
0 0 1 0 0 
1 0 0 0 0 
0 0 0 1 0 
0 1 0 0 0 
--------------
1 0 0 0 0 
0 0 0 1 0 
0 1 0 0 0 
0 0 0 0 1 
0 0 1 0 0 
--------------
0 0 0 0 1 
0 1 0 0 0 
0 0 0 1 0 
1 0 0 0 0 
0 0 1 0 0 
--------------
1 0 0 0 0 
0 0 1 0 0 
0 0 0 0 1 
0 1 0 0 0 
0 0 0 1 0 
--------------
0 1 0 0 0 
0 0 0 0 1 
0 0 1 0 0 
1 0 0 0 0 
0 0 0 1 0 
--------------
0 1 0 0 0 
0 0 0 1 0 
1 0 0 0 0 
0 0 1 0 0 
0 0 0 0 1 
--------------
0 0 1 0 0 
1 0 0 0 0 
0 0 0 1 0 
0 1 0 0 0 
0 0 0 0 1 
--------------

分析这道题的时候尝试过很多的办法，从题干去分析和从原理去分析，从以前的方法找灵感。

但是，千思万绪显得特别混杂，于是都无从下手。

可能看起来特别方便简单，但是其中都夹杂了许多的扩展与技巧，但是奇淫巧技不是最核心的，基础才是核心。

因此，我一步一步构建逻辑，然后全部模式、技巧的衔接点自动出现了。

千丝万缕的时候，可以回顾一下初心。

• 2.43

有一种傻瓜，叫做无可救药

在正则序和应用序的讨论的时候，可能还漏掉了一种傻瓜序。

我们已经知道，为了不失原意，正则序不论什么值，都会进行基础展开，直到用最基础的方式进行表达。

应用序在下沉之前，计算好表达式的值，然后逐层传递，不会进行进一步的展开。

前面我们做过一个对比，对于一个数半的得平方有两种方式

((lambda (x) (* x x)) (/ n 2)) 	;; 1
(* (/ n 2) (/ n 2))				;; 2

对于第一种方法，如果是正则序展开，它是和第二种方法等价的，但是应用序能够利用缓存，提升运行效率。

也就是说，应用序让我们的一些结果得以缓存，从而提高效率。同时，我们也可以使用特定的写法放弃这个优势。

如果对于 f ( x ) f(x) f(x)，我们需要计算 f ( x ) , 2 f ( x ) , 3 f ( x ) , 4 f ( x ) , 5 f ( x ) f(x), 2f(x), 3f(x), 4f(x),5f(x) f(x),2f(x),3f(x),4f(x),5f(x)，正常来说都会这样计算

(define (times-with times with)
  (define (times-iter iter)
    (if (not (< iter times))
        (begin
          (display (* iter with))
          (times-iter (+ iter 1)))))
  (times-iter 0))

如果废物一点呢，大概是这么做的吧

(define (times-with times x)
  (define (times-iter iter)
    (if (not (< iter times))
        (begin
          (display (* iter (f x)))
          (times-iter (+ iter 1)))))
  (times-iter 0))

也就是每次都手动去计算，这种方式，应用序也没办法，这种写法，必定会进行执行。

然后问题来了， f ( x ) f(x) f(x)消耗多少时间呢，如果 f ( x ) f(x) f(x)特别耗时，这本身简直是个 bug \text{bug} bug。

对于本题中的情况，就是对于这种一个递归计算式的循环计算，开销巨大，浪费。

画家

• origin

  • painter

• 样式

  • flip-vert：垂直翻转
  • flip-horiz：水平翻转

• 组合

  • beside：左右组合
  • below：上下组合

模式

• 环绕

(define (flipped-pairs painter) 
  (let ((painter2 (beside painter (flip-vert painter))))
    (below painter2 painter2)))

水平翻转后拼接，然后上下对齐。

• 左右递归

(define (right-split painter n) 
  (if (= n 0) 
      painter 
      (let ((smaller (right-spliter painter (- n 1))))
        (beside painter (below smaller smaller)))))

其中隐藏了尺寸变化，我们假设它的尺寸是自动变化的。

忽略递归条件，直面传递关系：它分为左右两部分，左边原图，右边分为上下两部分子图。

然后我们再来回顾一下所谓子图：递归决定的结构相似，它和上述结构一致。

这里也能够提取一个技巧：对于带结果递归，我们可以先计算递归，后续排布。

这样一来，就能够避免贯通和理清两条线，更易于递归的梳理。

• 嵌套递归

(define (corner-split painter n)
  (if (= n 0)
      painter
      ;; 上侧递归
      (let ((up (up-split painter (- n 1)))
            ;; 右侧递归
            (right (right-split painter (- n 1))))
        ;; 左上
        (let ((top-left (beside up up))
              ;; 右下
              (bottom-right (below right right))
              ;; 对角
              (corner (corner-split painter (- n 1))))
          ;; 原图+上递归
          (beside (below painter top-left)
                  ;; 右递归+角递归
                  (below bottom-right corner))))))

刚总结的技巧，这立刻就需要使用上了。

和单纯的right-split和top-split不一样，非单纯递归的情景下，递归的组合变成了家常便饭。

面对明显递归特征的时候，可以先简单的抽取模式，不一定要唯一，逐渐抽取之后再组合，逻辑会更清晰。

• 四角递归

(define (square-limit painter n)
  (let ((quarter (corner-split painter n)))
    (let ((half (beside (flip-horiz quarter) quarter)))
      (below (flip-vert half) half))))

在直接递归的过程中，我们的思维是全局思维，对于这张图而言，是固定尺寸的分割。

但是当递归种类多、嵌套层级深的时候，我们思维容易陷入分割的细节中去。

但是组合递归的方式，从小累到大，相当于是向上拼装的，虽然都是针对局部的思维，但是细节更丰富。

组合递归的优异性在于，原生的符合递归特性，也就是基于结果进行前进。

---

• 2.44

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

---

• 上下左右

(define (square-of-four tl tr bl br) 
  (lambda (painter) 
    (let ((top (beside (tl painter) (tr painter)))
          (bottom (beside (bl painter) (br painter))))
      (below botton top))))

• flipped-pairs

(define (flipped-pairs painter)
  (let ((combine (square-of-four identity flip-vert
                                 identity flip-vert)))
    (combine painter)))

• square-limit

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

---

• 2.45

先把up-split和right-split都再看一遍

(define (right-split painter n) 
  (if (= n 0) 
      painter 
      (let ((smaller (right-spliter painter (- n 1))))
        (beside painter (below smaller smaller)))))

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

不难提取出这个模板

(define (split op1 op2)
  (define (combine-operation painter n)
    (if (= n 0)
        painter
        (let ((smaller (combine-operation painter (- n 1))))
          (op1 painter (op2 smaller smaller)))))
  combine-operation)

• 2.46

(define (make-vert x y)
  (cons x y))

(define (xcor-vert vert)
  (car vert))

(define (ycor-vert vert)
  (cdr vert))

(define (add-vert v1 v2)
  (make-vert (+ (xcor-vert v1) (xcor-vert v2)) (+ (ycor-vert v1) (ycor-vert v2))))

(define (sub-vert v1 v2)
  (make-vert (- (xcor-vert v1) (xcor-vert v2)) (- (ycor-vert v1) (ycor-vert v2))))

(define (scale-vert scale vert)
  (make-vert (* scale (xcor-vert vert)) (* scale (ycor-vert vert))))

• 2.47

;; (define (make-frame origin edge1 edge2) (list origin edge1 edge2))
(define (origin-frame frame) 
  (car frame))
(define (edge1-frame frame) 
  (cadr frame))
(define (dege2-frame frame) 
  (cadr (cdr frame)))
;; (define (make-frame origin edge1 edge2) (cons origin (cons dege1 edge2)))
(define (origin-frame frame) 
  (car frame))
(define (edge1-frame frame) 
  (car (cdr frame)))
(define (edge2-frame frame) 
  (car (cdr (cdr frame))))

(define (frame-coodr-map frame)
  (lambda (v)
    (add-vert
     (origin-frame frame)
     (add-vert (scale-vert (xcor-vert v)
               (edge1-frame frame))
               (scale-vert (ycor-vert v)
                           (edge2-frame frame))))))

frame = ( ( o x , o y ) , ( e 1 x , e 1 y ) , ( e 2 x , e 2 y ) ) vector = ( v x , v y ) f ( frame, vector ) = ( o x , o y ) + ( v x ( e 1 x , e 1 y ) + v y ( e 2 x , e 2 y ) ) = ( o x , o y ) + ( v x e 1 x + v y e 2 x , v x e 1 y + v y e 2 y ) = ( o x + v x e 1 x + v y e 2 x , o y + v x e 1 y + v y e 2 y ) \begin{aligned} \text{frame} &= ((o_x, o_y), (e1_x, e1_y), (e2_x, e2_y)) \\ \text{vector} &= (v_x, v_y) \\ f(\text{frame, vector}) &= (o_x, o_y) + (v_x(e1_x, e1_y) + v_y(e2_x, e2_y)) \\ &= (o_x, o_y) + (v_xe1_x + v_ye2_x, v_xe1_y +v_ye2_y) \\ &=(o_x + v_xe1_x + v_ye2_x, o_y + v_xe1_y +v_ye2_y) \end{aligned} framevectorf(frame, vector)​=((ox​,oy​),(e1x​,e1y​),(e2x​,e2y​))=(vx​,vy​)=(ox​,oy​)+(vx​(e1x​,e1y​)+vy​(e2x​,e2y​))=(ox​,oy​)+(vx​e1x​+vy​e2x​,vx​e1y​+vy​e2y​)=(ox​+vx​e1x​+vy​e2x​,oy​+vx​e1y​+vy​e2y​)​

首先，根据 ( o x , o y ) (o_x, o_y) (ox​,oy​)进行位移，然后指定向量，分别按照 ( e 1 x , e 2 x ) (e1_x,e2_x) (e1x​,e2x​)和 ( e 1 y , e 2 y ) (e1_y,e2_y) (e1y​,e2y​)的分量进行调整.

• 2.48

(define (make-segment start-segment end-segment)
  (make-vert start-segment end-segment))

(define (start-segment segment)
  (xcor-vert segment))

(define (end-segment segment)
  (ycor-vert segment))

(define (segment->painter segment-list) 
  (lambda (frame) 
    (for-each 
     (lambda (segment) 
       (draw-line
        ((frame-coord-map frame) (start-segment segment))
        ((frame-coord-map frame) (end-segment segment))))
     segment-list)))x`

• 2.49

a)

(define (creat-segment x1 x2 y1 y2)
  (make-segment (make-vect x1 y1) (make-vect x2 y2)))

(define (create-segments x1 x2 y1 y2)
  (list (create-segment x1 x1 y1 y2)
        (create-segment x2 x2 y1 y2)
        (create-segment x1 x2 y1 y1)
        (create-segment x1 x2 y2 y2)))
(segments-painter (create-segments x1 x2 y1 y2))

b)

(define (create-segment-x x1 x2 y1 y2)
  (append (create-segments x1 x2 y1 y2)
          (list (create-segment x1 x2 y1 y2)
                (create-segment x1 x2 y2 y1))))
(segments-painter (create-segment-x x1 x2 y1 y2))

c)

(define (create-segment-center x1 x2 y1 y2)
  (let ((x (/ (+ x1 x2) 2))
        (y (/ (+ y1 y2) 2)))
    (append (create-segments x1 x2 y1 y2)
            (list (create-segment x1 x y y)
                  (create-segment x x2 y2 y)
                  (create-segment x2 x y y1)
                  (create-segment x x1 y1 y)))))
(segments-painter (create-segment-center x1 x2 y1 y2))

(define (transform-painter origin corner1 corner2)
  (lambda (frame)
    (let ((m (frame-coord-map frame)))
      (let ((new-origin (m origin)))
        (painter
         (make-frame new-origin
                     (sub-vect (m corner1) new-origin)
                     (sub-vect (m corner2) new-origin)))))))

对于该计算结果，可以有很多种的理解方式，在这里， 用最简单的就好：
全部图像画布，都是正方形，而且描述方式都是原点，横轴，纵轴，如是而已

  y(0,1)
     ^ 
     |
     |
(0,0)o - - > x(1,0)

• 反转

frame = { origin = ( 0.0 , 1.0 ) edge1 = ( 1.0 , 1.0 ) edge2 = ( 0.0 , 0.0 ) \text{frame} = \left\{ \begin{matrix} \text{origin} = (0.0,1.0) \\ \text{edge1} = (1.0,1.0) \\ \text{edge2} = (0.0,0.0) \\ \end{matrix}\right. frame=⎩⎨⎧​origin=(0.0,1.0)edge1=(1.0,1.0)edge2=(0.0,0.0)​

(1,0)o - - >x(1,1)
     |
     |
     v
   y(0,0)

准确来说应该是上下翻转。

• 缩放

frame = { origin = ( 0.5 , 0.5 ) edge1 = ( 1.0 , 0.5 ) edge2 = ( 0.5 , 1.0 ) \text{frame} = \left\{ \begin{matrix} \text{origin} = (0.5,0.5) \\ \text{edge1} = (1.0,0.5) \\ \text{edge2} = (0.5,1.0) \\ \end{matrix}\right. frame=⎩⎨⎧​origin=(0.5,0.5)edge1=(1.0,0.5)edge2=(0.5,1.0)​

      y(0.5,1.0)
           ^ 
           |
  (0.5,0.5)o - > x(1.0,0.5)
      
      
 O

缩在左上角

• 逆时针

frame = { origin = ( 1.0 , 0.0 ) edge1 = ( 1.0 , 1.0 ) edge2 = ( 0.0 , 0.0 ) \text{frame} = \left\{ \begin{matrix} \text{origin} = (1.0,0.0) \\ \text{edge1} = (1.0,1.0) \\ \text{edge2} = (0.0,0.0) \\ \end{matrix}\right. frame=⎩⎨⎧​origin=(1.0,0.0)edge1=(1.0,1.0)edge2=(0.0,0.0)​

          x(1,1)
           ^
           |
           |
y(0,0)< - -o(1,0)

的确是逆时针 9 0 ∘ 90^\circ 90∘

• 中心收缩

frame = { origin = ( 0.0 , 0.0 ) edge1 = ( 0.65 , 0.35 ) edge2 = ( 0.35 , 0.65 ) \text{frame} = \left\{ \begin{matrix} \text{origin} = (0.0,0.0) \\ \text{edge1} = (0.65,0.35) \\ \text{edge2} = (0.35,0.65) \\ \end{matrix}\right. frame=⎩⎨⎧​origin=(0.0,0.0)edge1=(0.65,0.35)edge2=(0.35,0.65)​

文本没有这个斜率的线，想象一下就行了。

• 2.50

有了前面的经验，可以直接写出来

水平翻转

          y(1,1)
           ^
           |
           |
x(0,0)< - -o(1,0)

frame = { origin = ( 1.0 , 0.0 ) edge1 = ( 0.0 , 0.0 ) edge2 = ( 1.0 , 1.0 ) \text{frame} = \left\{ \begin{matrix} \text{origin} = (1.0,0.0) \\ \text{edge1} = (0.0,0.0) \\ \text{edge2} = (1.0,1.0) \\ \end{matrix}\right. frame=⎩⎨⎧​origin=(1.0,0.0)edge1=(0.0,0.0)edge2=(1.0,1.0)​

逆时针 18 0 ∘ 180^\circ 180∘

x(0,1)< - -o(1,1)        
           |
           |
           v
         y(1,0) 

frame = { origin = ( 1.0 , 1.0 ) edge1 = ( 0.0 , 1.0 ) edge2 = ( 1.0 , 0.0 ) \text{frame} = \left\{ \begin{matrix} \text{origin} = (1.0,1.0) \\ \text{edge1} = (0.0,1.0) \\ \text{edge2} = (1.0,0.0) \\ \end{matrix}\right. frame=⎩⎨⎧​origin=(1.0,1.0)edge1=(0.0,1.0)edge2=(1.0,0.0)​

逆时针 27 0 ∘ 270^\circ 270∘

(0,1)o - - >y(1,1)       
     |
     |
     v
   x(0,0)

frame = { origin = ( 0.0 , 1.0 ) edge1 = ( 0.0 , 0.0 ) edge2 = ( 1.0 , 1.0 ) \text{frame} = \left\{ \begin{matrix} \text{origin} = (0.0,1.0) \\ \text{edge1} = (0.0,0.0) \\ \text{edge2} = (1.0,1.0) \\ \end{matrix}\right. frame=⎩⎨⎧​origin=(0.0,1.0)edge1=(0.0,0.0)edge2=(1.0,1.0)​

• 2.51

(define (map-below painter1 painter 2)
  (let ((up (transform-painter painter1
                               (make-vert 0.0 0.5)
                               (make-vert 1.0 0.0)
                               (make-vert 0.0 1.0)))
        (bottom (transform-painter painter2
                                   (make-vert 0.0 0.0)
                                   (make-vert 1.0 0.0)
                                   (make-vert 0.0 0.5))))
    (lambda (frame)
      (up frame)
      (bottom frame))))

一个上边，一个下边，没毛病。

(define (rotate-below painter1 painter2)
  (rotate270 (beside (rotate90 painter1) (rotate90 painter2))))

beside，如果不考虑角度，其实旋转拼接就完成了，然后旋转把图像拨正。

只要总旋转的角度为 36 0 ∘ 360^\circ 360∘，就没啥问题。

• 2.52

a) 没意思

b)

(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 (blow painter up)
                (blow right corner)))))

分为四块，随便拼接。

c)

(define (square-limit painter n)
  (let ((combine (square-of-four identify flip-horiz
                                 flip-vect rotate180)))
    (combine (corner-split painter n))))

没啥要求，随便写。

标签：cons,car,list,sicp,iter,cdr,2.2,define
来源： https://blog.csdn.net/wait_for_eva/article/details/111881827

本站声明： 1. iCode9 技术分享网（下文简称本站）提供的所有内容，仅供技术学习、探讨和分享；
2. 关于本站的所有留言、评论、转载及引用，纯属内容发起人的个人观点，与本站观点和立场无关；
3. 关于本站的所有言论和文字，纯属内容发起人的个人观点，与本站观点和立场无关；
4. 本站文章均是网友提供，不完全保证技术分享内容的完整性、准确性、时效性、风险性和版权归属；如您发现该文章侵犯了您的权益，可联系我们第一时间进行删除；
5. 本站为非盈利性的个人网站，所有内容不会用来进行牟利，也不会利用任何形式的广告来间接获益，纯粹是为了广大技术爱好者提供技术内容和技术思想的分享性交流网站。