Marvin's Blog【程式人生】

Ability will never catch up with the demand for it

26 Sep 2020

The Little Schemer读书笔记(四)

第五章(On My Gawd*: It’s Full of Stars)以及第六章(Shadows)

之前的章节涉及的list一般都是由atom构成,这章开始处理list of list,也就是表中表。原先一个方向的递归,现在要变成两个方向了。如果原先的递归称为右递归的话,现在要进行左递归了。

首先出场的是rember*,依然是删除某个atom,但是也会对嵌套的list做同样的处理。例子:(rember* 'cup '((coffee) cup ((tea) cup) (and (hick)) cup)的结果是((coffee) ((tea)) (and (hick))

(define rember*
    (lambda (a l)
      (cond
        ((null? l) '())
        ((atom? (car l)) (cond
                           ((eq? (car l) a) (rember* a (cdr l)))
                           (else (cons (car l) (rember* a (cdr l))))))
        (else (cons (rember* a (car l)) (rember* a (cdr l)))))))

接下来把insertR改成双递归版本的insertR*:

 (define insertR*
    (lambda (new old l)
      (cond
        ((null? l) '())
        ((atom? (car l))
           (cond
             ((eq? (car l) old) (cons old (cons new (insertR* new old (cdr l)))))
             (else (cons (car l) (insertR* new old (cdr l))))))
        (else (cons (insertR* new old (car l)) (insertR* new old (cdr l)))))))

为了支持双递归,需要对戒律做一些修改。下面是对第一条戒律的修改:

The First Commandment (final version): When recurring on a list of atoms, lat, ask two questions about it: (null? lat) and else. When recurring on a number, n, ask two questions about it: (zero? n) and else. When recurring on a list of S-expression, l, ask three question about it: (null? l), (atom? (car l)), and else.

下面是对第二条戒律的修改:

The Fourth Commandment (final version): Always change at least one argument while recurring. When recurring on a list of atoms, lat, use (cdr lat). When recurring on a number, n, use (sub1 n). And when recurring on a list of S-expressions, l, use (car l) and (cdr l) if neither (null? l) nor (atom? (carl)) are true. It must be changed to be closer to termination. The changing argument must be tested in the termination condition:

when using cdr, test termination with null? and when using sub1, test termination with zero?.

下面对occurs进行改造:

 (define occurs*
    (lambda (a l)
      (cond
        ((null? l) 0)
        ((atom? (car l))
           (cond
             ((eq? a (car l)) (add1 (occurs* a (cdr l))))
             (else (occurs* a (cdr l)))))
        (else (0+ (occurs* a (car l)) (occurs* a (cdr l)))))))

接着对subst*进行改造:

 (define subst*
    (lambda (new old l)
      (cond
        ((null? l) '())
        ((atom? (car l))
         (cond
           ((eq? (car l) old) (cons new (subst* new old (cdr l))))
           (else (cons (car l) (subst* new old (cdr l))))))
        (else (cons (subst* new old (car l)) (subst* new old (cdr l)))))))

然后是insertL*:

 (define insertL*
    (lambda (new old l)
      (cond
        ((null? l) '())
        ((atom? (cdr l))
         (cond
           ((eq? old (car l))
            (cons new
              (cons old
                (insertL* new old (cdr l)))))
           (else (cons (car l)
                   (insertL* new old (cdr l))))))
        (else (cons (insertL* new old (car l))
                (insertL* new old (cdr l)))))))

轮到member*了:

 (define member*
    (lambda (a l)
      (cond
        ((null? l) #f)
        ((atom? (car l))
         (cond
           ((eq? a (car l)) #t)
           (else (member* a (cdl l)))))
        (else (or (member* a (car l))
                  (member* a (cdr l)))))))

下一位是leftmost,作用是通过左递归深度遍历找到第一个atom,书中描述如下:

The function leftmost finds the leftmost atom in a non-empty list of S-expressions that does not contain the empty list.

 (define leftmost
    (lambda (l)
      (cond
        ((atom? (car l) (car l)))
        (else (leftmost (cdr l))))))

下一个例子要使用or和and,下面是对这两者的解释:

(or …) ask questions one at a time until it finds one that is true. Then (or …) stops, making its value true. If it cannot find a true argument, the value of (or …) is false. (and …) asks questions one at a time until it finds one whose value is false. Then (and …) stops with false. If none of the exressions are false, (and …) is true.

eqlist?用来判断两个list是否相等:

 (define eqlist?
    (lambda (l1 l2)
      (cond
        ((and (null? l1) (null? l2)) #t)
        ((or (null? l1) (null? l2) #f))
        ((and (atom? (car l1) (atom? (car l2)))
              (and (eqan? (car l1) (car l2))) (eqlist? (cdr l1) (cdr l2)))))
        ((or (atom? (car l1)) (atom? (car l2))) #f)
        (else (and (eqlist? (car l1) (carl2)) (eqlist? (cdr l1) (cdr l2)))))))

上面的例子稍显复杂。可以通过提取一个中间函数equal?来简化:

 (define equal?
    (lambda (s1 s2)
      (cond
        ((and (atom? s1) (atom? s2)) (eqan? s1 s2))
        ((atom? s1) #f)
        ((atom? s2) #f)
        (else (eqlist? s1 s2)))))

上面cond的第二和第三条件也可以简写为((or (atom? s1) (atom? s2)) #f)

equal?对于list中的每一节点,判断是否相等。节点既可能是atom又可能是list。如果是atom,则通过eqan?判断两个atom是否,如果是list的话,则调用上一级的eqlist?来进行比较。

由此,eqlist?除了判断是否是空list之外,其他的事件就可以交给equal?处理:

 (define eqlist?
    (lambda (l1 l2)
      (cond
        ((and (null? l1) (null? l2)) #t)
        ((or (null? l1) (null? l2)) #f)
        (else (and
                (equal? (car l1) (car l2))
                (equal? (cdl l1) (cdr l2)))))))

此处迎来第六戒律:

The Sixth Commandment: Simplify only after the function is correct.

将rember扩展成从list移除任意的s-expression:

 (define rember
    (lambda (s l)
      (cond
        ((null? l) '())
        ((atom? s) (cond
                     ((equal? s (car l)) (cdr l))
                     (else (cons (car l) (rember s (cdr l))))))
        (else (cond
                ((equal? s (car l)) (cdr l))
                (else (cons (car l) (rember s (cdr l)))))))))

明显,上面的rember定义可以做一些简化:

 (define rember
    (lambda (s l)
      (cond
        ((null? l) '())
        (else (cond
                ((equal? (car l) s) (cdr l))
                (else (cons (car l) (rember s (cdr l)))))))))

或者进一步简化:

 (define rember
    (lambda (s l)
      (cond
        ((null? l) '())
        ((equal? (car l) s) (cdr l))
        (else (cons (car l) (rember s (cdr l)))))))

将要出场的是numbered?,和之前的函数都不一样,这个函数用来判断list是否是一个算是表达式,对于(3 + (4 x 5),numbered?返回true。

直接就上简化版的numbered?吧:

 (define numbered?
    (lambda (aexp)
      (cond
        ((atom? aexp) (number? aexp))
        (else (and
                (numbered? (car aexp))
                (numbered? (car (cdr (cdr aexp)))))))))

可以看出numbered假设aexp不是atom就是带有三个节点的list,并且list的第一个和第三个节点都是numbered?为true。

顺应numbered?相同的思路,来帝国一value函数。value返回的不是真或者假,而是对其进行求值。所以value必须关心list第二节点上的操作符是什么:

 (define value
    (lambda (nexp)
      (cond
        ((atom? nexp) nexp)
        ((eq? (car nexp) '+)
         (+ (value (car nexp))
            (value (car (cdr (cdr nexp))))))
        ((eq? (car nexp) 'x)
         (* (value (car nexp))
            (value (car (cdr (cdr nexp))))))
        (else
          (^ (value (car nexp))
             (value (car (cdr (cdr (nexp))))))))))

第七戒律出现了:

The Seventh Commandment: Recur on the subparts that are of the same nature:

  • On the sublists of a list
  • On the subexpressions of an arithmetic expression

上面的value函数计算的是中序表达式,要计算前序表达式,比如(+ 1 3),需要做一定的改写。首先来定义两个帮助函数:

 (define 1st-sub-exp
    (lambda (aexp)
      (cond
        (else (car (cdr aexp))))))

 (define 2nd-sub-exp
    (lambda (aexp)
      (cond
        (else (car (cdr (cdr aexp)))))))

(define operator
  (lambda (aexp)
    (car aexp)))

 (define value
    (lambda (nexp)
      (cond
        ((atom? nexp) nexp)
        ((eq? (operator nexp) '+)
         (+ (value (1st-sub-exp nexp))
            (value (2nd-sub-exp nexp))))
        ((eq? (operator nexp) '*)
         (* (value (1st-sub-exp nexp))
            (value (2nd-sub-exp nexp))))
        (else
          (^ (value (1st-sub-exp nexp))
             (value (2nd-sub-exp nexp)))))))

第八戒律也很快出现了:

The Eighth Commandment Use help functions to abstract from representations.

(本篇完)

comments powered by Disqus