Marvin's Blog【程式人生】

Ability will never catch up with the demand for it

03 Oct 2020

The Little Schemer读书笔记(六)

The Little Schemer第八章 Lambda the Ultimate学习笔记。

首先出现的是rember-f,它是rember的演化版,接受一个额外的test?作为测试条件,来判断是否要移除目标节点。

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

有了rember-f之后,可以通过嵌套的方式定义出rember:

(define rember
    (lambda (a l)
      (rember-f eq? a l)))

但是书里面没有直接这么做,而是借用了一个中间函数来灵活给出rember-f的test?参数。我们先定义一个eq?-c:

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

eq?-c这种函数返回另一个函数的方式叫做currying。然后我们重新定义rember-f:

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

定义了新的rember-f,原先的(rember a l)就相当于((rember-f eq?) a l)了。

这样的话,rember就可以基于rember-f来定义:

(define rember
  (rember-f eq?)) 

同样的,可以有insertL-f以及insertR-f:

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

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

注意到上面的insertL-f和insertR-f的差别其实不大,书中的总结如下:

The two functions cons old and new in a different order onto the car of the list l.

所以,可以提取专门的函数来处理这个问题:

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

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

这样insertL和insertR的函数体可以共享一套代码了,我们给这套代码放到函数insert-g里面:

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

然后重新定义insertL和insertR

(define insertL (insert-g seqL))
(define insertR (insert-g seqR))

当然你也可以不使用辅助函数seqL和seqR,而是直接使用lambda:

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

接下来引入一个atom-to-function函数,其用途示例如下:(atom-to-function (operator nexp))在nexp为(+ 5 3)的时候,把作为atom的+转化为相应的加法函数。

然后使用atom-to-function可以简化前面章节定义过的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)))))))

multirember也可以改成-f版:

(define multirember-f
    (lambda (test?)
      (lambda (a lat)
        (cond
          ((null? lat) '())
          ((test? a (car lat)) ((multirember-f test?) a (cdr lat)))
          (else (cons (car lat) ((multirember-f test?) a (cdr lat))))))))

然后可以引出multirember-eq?:

(define multirember-eq?
    (multirember-f eq?))

接下来是另外一个版本的multiremberT,其判断条件直接从参数传入:

(define multiremberT
    (lambda (test? lat)
      (cond
        ((null? lat) '())
        ((test? (car lat)) (multiremberT test? (cdr lat)))
        (else (cons (car lat) (multiremberT test? (cdr lat)))))))

下面出场的是multiremberEco:

 (define multiremberEco
    (lambda (a lat col)
      (cond
        ((null? lat) (col '() '()))
        ((eq? a (car lat))
         (multiremberEco a (cdr lat)
           (lambda (newlat seen)
             (col newlat (cons (car lat) seen)))))
        (else (multiremberEco a (cdr lat)
                (lambda (newlat seen)
                  (col (cons (car lat) newlat) seen)))))))

上面的multiremberEco比之前学过的函数都复杂,因为col是一个函数类型的参数,在递归的时候被不断重复定义。你可能会猜col表示什么,其实它是collector的缩写,同时书中说到:

A collector is sometimes called a “continuation”.

我们定义一个a-friend来作为col参数:

 (define a-friend
    (lambda (x y)
      (null? y)))

可以看到(multiremberEco 'tuna '() a-friend)返回#t,以及(multiremberEco 'tuna '(tuna) a-friend)返回#f。

书中对multiremberEco的作用的描述:

It looks at every atom of the lat to see whether it is eq? to a. Those atoms that are not collected in one list ls1; the others for which the answer is true are collected in a second list ls2. Finally, it determines the value of (f ls1 ls2).

可以定义一个新的collector,来计算newlat的长度:

 (define last-friend
    (lambda (x y)
      (length x)))

下面是第十条戒律:

The Tenth Commandment: Build functions to collect more than one value at a time.

接下来话锋一转,讲到multiinsertLR,这个可以看作是multiinsertL和multiinsertR的合体:

(define multiinsertLR
    (lambda (new oldL oldR lat)
      (cond
      ((null? lat) '())
      ((eq? oldL (car lat)) 
       (cons new (cons oldL (multiinsertLR new oldL oldR lat))))
      ((eq? oldR (car lat))
       (cons oldR (cons new (multiinsertLR new oldL oldR lat))))
      (else (cons (car lat) (multiinsertLR new oldL oldR lat))))))

现在将multiinsertLR改写成multiinsertLREco,后者接受一个额外的collector参数:

 (define multiinsertLREco
    (lambda (new oldL oldR lat col)
      (cond
        ((null? lat) (col '() 0 0 ))
        ((eq? (car lat) oldL)
         (multiinsertLREco new oldL oldR (cdr lat)
           (lambda (newlat L R)
             (col (cons new (cons oldL newlat)) (+ L 1) R))))
        ((eq? (car lat) oldR)
         (multiinsertLREco new oldL oldR (cdr lat)
           (lambda (newlat L R)
             (col (cons oldR (cons new newlat)) L (+ R 1)))))
        (else 
          (multiinsertLREco new oldL oldR (cdr lat)
            (lambda (newlat L R)
              (col (cons (car lat) newlat) L R)))))))

接下来话锋一转,转而处理数字了,首先定义even?:

 (define even?
    (lambda (n)
      (= (* (/ n 2) 2) n)))

当一个数除以2,然后乘以2,还等于自身,那么对这个数even?就返回#t。但是在chez schemer里面/函数会产生分数,所以(even? 9)的结果其实是#t。解决办法要么是

evens-only找出列表中所有的even?为#t的数。evens-only是一个*-function,其处理的列表要么为空,节点可以是atom或者list,书中的说法:

all *-functions work on lists that are either

  • empty,
  • an atom concede onto a list, or
  • a list conned onto a list.
 (define evens-only*
    (lambda (l)
      (cond
        ((null? l) '())
        ((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)))))))

现在需要构建一个Eco版的evens-only*,不仅在结果中筛选出event?为#t的数,而且还将所有的even数相乘,odd数相加。

(define evens-only*Eco
    (lambda (l col)
      (cond
        ((null? l) (col '() 1 0))
        ((atom? (car l))
         (cond
           ((even? (car l)) (evens-only*Eco (cdr l)
                              (lambda (newl p s)
                                (col (cons (car l) newl) (* p (car l)) s))))
           (else (evens-only*Eco (cdr l)
                   (lambda (newl p s)
                     (col newl p (+ s (car l))))))))
        (else (evens-only*Eco (car l)
                (lambda (al ap as)
                  (evens-only*Eco (cdr l)
                   (lambda (dl dp ds)
                     (col (cons al dl)
                          (* ap dp)
                          (+ as ds))))))))))

下面给出一个collector,叫做the-last-friend:

(define the-last-friend
    (lambda (newl product sum)
      (cons sum (cons product newl))))

运行 (evens-only*Eco '((9 1 2 8) 3 10 ((9 9) 7 6) 2) the-last-friend)返回的结果是(38 1920 (2 8) 10 (() 6) 2)

(本篇完)

comments powered by Disqus