《The Little Schemer》知识点整理(八):Lambda 终结者

准备知识

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

Scheme 十诫之第九诫

用函数来抽象通用模式。

Scheme 十诫之第十诫

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

自定义函数

(rember-f test? a l)

定义:函数版本的 rembertest? 至少有以下几种情况:

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

实现:

1
2
3
4
5
6
7
(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)))))))

如果返回一个函数:

1
2
3
4
5
6
7
8
(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 是否相同。

实现:

1
2
3
4
(define eq?-c
(lambda (a)
(lambda (x)
(eq? x a))))

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

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

实现:

1
2
3
4
5
6
7
8
9
(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

实现:

1
2
3
4
5
6
7
8
9
(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 第一个参数到这个结果上。

实现:

1
2
3
(define seqL
(lambda (new old l)
(cons new (cons old l))))

(seqR new old l)

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

实现:

1
2
3
(define seqR
(lambda (new old l)
(cons old (cons new l))))

((insert-g seq) new old l)

定义:引入 insert-g,可以表示 insertL 或者 insertR。这里 seqseqL 或者 seqR

1
2
3
4
5
6
7
8
9
(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 可以这样做:

1
(define insertL (insert-g seqL))

同样的,insertR

1
(define insertR (insert-g seqR))

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

1
2
3
4
(define insertL
(insert-g
(lambda (new old l)
(cons new (cons old l)))))

考虑以前定义过的 subst,也可以这么写:

1
2
3
4
(define subst
(insert-g
(lambda (new old l)
(cons new l))))

(atom-to-function x)

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

实现:

1
2
3
4
5
6
(define atom-to-function
(lambda (x)
(cond
((eq? x (quote +)) plus)
((eq? x (quote ×)) ×)
(else ↑))))

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

1
2
3
4
5
6
7
8
(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) 的值。

实现:

1
2
3
4
5
6
7
8
9
10
11
12
13
(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 的右边,同时记录左右分别插入了多少次。

实现:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
(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?

1
2
3
(define even?
(lambda (n)
(= (× (÷ n 2) 2) n)))
1
2
3
4
5
6
7
8
9
10
11
12
(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 函数,其从一个列表中移除所有奇数项,以构建一个偶数项的嵌套列表,同时求出该列表所有偶数项的乘积和奇数项的和。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
(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,并收集偶数项,偶数项乘积和奇数项之和,可以这么定义:

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

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

1
2
3
4
5
6
(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 –