The Little Schemer 知识点整理（八）：Lambda 终结者

2019 年 01 月 09 日

准备知识

  1. 函数可以返回原子和列表；它也能返回一个函数。
  2. 你可能听说过函数“柯里化”。
  3. col 是 collector 的缩写，有时又叫 continuation。

Scheme 十诫之第九诫

用函数来抽象通用模式。

Scheme 十诫之第十诫

构建函数，一次收集多个值。

自定义函数

(rember-f test? a l)

定义：函数版本的 rember。test? 至少有以下几种情况：

  • test? 是 =
  • test? 是 eq?
  • test? 是 equal?

实现：

(define rember-f
  (lambda (test? a l)
    (cond
      ((null? l) (quote ()))
      ((test? (car l) a) (cdr l))
      (else (cons (car l)
                  (rember-f test? a (cdr l)))))))

如果返回一个函数：

(define rember-f
  (lambda (test?)
    (lambda (a l)
      (cond
        ((null? l) (quote ()))
        ((test? (car l) a) (cdr l))
        (else (cons (car l)
                    ((rember-f test?) a (cdr l))))))))

用法就变成 ((rember-f test?) a l)。

(eq?-c a)

定义：其返回一个函数，这个函数用于比较原子 x 与 a 是否相同。

实现：

(define eq?-c
  (lambda (a)
    (lambda (x)
      (eq? x a))))

((insertL-f test?) new old l)

定义：按照 rember 转换 rember-f 的思路转换 insertL。

实现：

(define insertL-f
  (lambda (test?)
    (lambda (new old l)
      (cond
        ((null? l) (quote ()))
        ((test? (car l) old)
          (cons new (cons old (cdr l))))
        (else (cons (car l)
                    ((insertL-f test?) new old (cdr l))))))))

((insertR-f test?) new old l)

定义：按照 rember 转换 rember-f 的思路转换 insertR。

实现：

(define insertR-f
  (lambda (test?)
    (lambda (new old l)
      (cond
        ((null? l) (quote ()))
        ((test? (cdr l) old)
          (cons old (cons new (cdr l))))
        (else (cons (cdr l)
                    ((insertR-f test?) new old (cdr l))))))))

比较上述两个函数的差异，发现在于中间的某一行。于是我们引入以下两个函数。

(seqL new old l)

定义：cons 第二个参数到第三个参数上，得到一个结果，然后再 cons 第一个参数到这个结果上。

实现：

(define seqL
  (lambda (new old l)
    (cons new (cons old l))))

(seqR new old l)

定义：cons 第一个参数到第三个参数上，得到一个结果，然后再 cons 第二个参数到这个结果上。

实现：

(define seqR
  (lambda (new old l)
    (cons old (cons new l))))

((insert-g seq) new old l)

定义：引入 insert-g，可以表示 insertL 或者 insertR。这里 seq 是 seqL 或者 seqR。

(define insert-g
  (lambda (seq)
    (lambda (new old l)
      (cond
        ((null? l) (quote ()))
        ((eq? (car l) old)
          (seq new old (cdr l)))
        (else (cons (cdr l)
                    ((insert-g seq) new old (cdr l))))))))

那么我们定义 insertL 可以这样做：

(define insertL (insert-g seqL))

同样的，insertR：

(define insertR (insert-g seqR))

但是其实不需要单独定义函数，我们可以直接传递整个定义：

(define insertL
  (insert-g
    (lambda (new old l)
      (cons new (cons old l)))))

考虑以前定义过的 subst，也可以这么写：

(define subst
  (insert-g
    (lambda (new old l)
      (cons new l))))

(atom-to-function x)

定义：我们提取 value （第六章）的公共部分，这个函数相当于数学符号的 parser，根据读取到的不同原子（+×↑）来定义运算方法。

实现：

(define atom-to-function
  (lambda (x)
    (cond
      ((eq? x (quote +)) plus)
      ((eq? x (quote ×)) ×)
      (else ↑))))

那么我们的 value 函数可以写成：

(define value
  (lambda (nexp)
    (cond
      ((atom? nexp) nexp)
      (else
        ((atom-to-function (operator nexp))
          (value (1st-sub-exp nexp))
          (value (2nd-sub-exp nexp)))))))

以下函数在实现功能的同时，又用 col 收集了其他我们想要的值。

(multirember&co a lat col)

定义：查找 lat 的每个原子，判断该原子是否等于 a，否的话那些原子被收集进 ls1 中，是的话被收集进 ls2 中。最后计算 (col ls1 ls2) 的值。

实现：

(define multirember&co
  (lambda (a lat col)
    (cond
      ((null? lat)
        (col (quote ()) (quote ())))
      ((eq? (car lat) a)
        (multirember&co a (cdr lat)
          (lambda (newlat seen)
            (col newlat (cons (car lat) seen)))))
      (else
        (multirember&co a (cdr lat)
          (lambda (newlat seen)
            (col (cons (car lat) newlat) seen)))))))

(multiinsertLR&co new oldL oldR lat col)

定义：将 new 插入到 lat 的 oldL 的左边和 oldR 的右边，同时记录左右分别插入了多少次。

实现：

(define multiinsertLR&co
  (lambda (new oldL oldR lat col)
    (cond
      ((null? lat)
        (col (quote ()) 0 0))
      ((eq? (car lat) oldL)
        (multiinsertLR&co new oldL oldR (cdr lat)
          (lambda (newlat L R)
            (col (cons new (cons oldL newlat)) (add1 L) R))))
      ((eq? (car lat) oldR)
        (multiinsertLR&co new oldL oldR (cdr lat)
          (lambda (newlat L R)
            (col (cons oldR (cons new newlat)) L (add1 R)))))
      (else (multiinsertLR&co new oldL oldR (cdr lat)
        (lambda (newlat L R)
          (col (cons (car lat) newlat) L R)))))))

(evens-only* l)

定义：去除 l 中所有的奇数。

我们先定义判断偶数的函数 even?：

(define even?
  (lambda (n)
    (= (× (÷ n 2) 2) n)))
(define evens-only*
  (lambda (l)
    (cond
      ((null? l) (quote ()))
      ((atom? (car l))
        (cond
          ((even? (car l))
            (cons (car l)
                  (evens-only* (cdr l))))
          (else (evens-only* (cdr l)))))
      (else (cons (evens-only* (car l))
                  (evens-only* (cdr l)))))))

接下来试着写一个 evens-only*&co 函数，其从一个列表中移除所有奇数项，以构建一个偶数项的嵌套列表，同时求出该列表所有偶数项的乘积和奇数项的和。

(define evens-only*&co
  (lambda (l col)
    (cond
      ((null? l) (col (quote ()) 1 0))
      ((atom? (car l))
        (cond
          ((even? (car l))
            (evens-only*&co (cdr l)
              (lambda (newl p s)
                (col (cons (car l) newl) (× (car l) p) s))))
          (else (evens-only*&co (cdr l)
            (lambda (newl p s)
              (col newl p (plus (car l) s)))))))
      (else (evens-only*&co (car l) ...)))))

可以发现 (evens-only*&co (cdr l) ...) 的 collector 很好写，但是 (evens-only*&co (car l) ...) 的 collector 应该怎么写呢？

首先这个 collector 要通过 evens-only*&co 访问 l 的 cdr，并收集偶数项，偶数项乘积和奇数项之和，可以这么定义：

(lambda (al ap as)
  (evens-only*&co (cdr l)
    ...))

然后接下来的一个 collector 要做的是，把 (cdr l) 和 (car l) 所收集的值——偶数项、偶数项乘积、奇数项之和——cons、累乘、累加：

(lambda (al ap as)
  (evens-only*&co (cdr l)
    (lambda (dl dp ds)
      (col (cons al dl)
           (× ap dp)
           (plus as ds)))))

这就是上面 evens-only*&co 所缺失的定义了。

EOF

Twinkle 的博客
瞎折腾