The Seasoned Schemer

11. Welcome Back to the Show

;; 回忆member?函数
(define member?
  (lambda (a lat)
    (cond
     [(null? lat) #f]
     [else
       (or (eq? a (car lat))
           (member? a (cdr lat)))])))

(member? 'a '(c d b a f))

#t

;; 定义two-in-a-row?, 一行中连续两个元素
(define is-first?
  (lambda (a lat)
    (cond
     [(null? lat) #f]
     [else (eq? a (car lat))])))

(define two-in-a-row?
  (lambda (lat)
    (cond
     [(null? lat) #f]
     [else
      (or (is-first? (car lat) (cdr lat))
          (two-in-a-row? (cdr lat)))])))

(two-in-a-row? '(italian sardines sardines spaghetti parsley))

#t

;; 计算前缀和
(define sum-of-prefixes-b
  (lambda (sonssf tup)
    (cond
     [(null? tup) '()]
     [else
      (cons (+ sonssf (car tup))
            (sum-of-prefixes-b
             (+ sonssf (car tup))
             (cdr tup)))])))

(define sum-of-prefixes
  (lambda (tup)
    (sum-of-prefixes-b 0 tup)))

(sum-of-prefixes '(1 1 1 1 1))

(1 2 3 4 5)

Use additional arguments when a function needs to known what other arguments to the function have been like so far.

The function scramble takes a non-empty tup in which no number is greater than its own index, and returns a tup of the same

;; pick函数
(define pick
  (lambda (n xs)
    (cond
     [(= n 1) (car xs)]
     [else (pick (- n 1) (cdr xs))])))

(pick 3 '(1 2 3))

3

;; rev-pre: reversed prefix
(define scramble-b
  (lambda (tup rev-pre)
    (cond
     [(null? tup) '()]
     [else
      (cons (pick (car tup)
                  (cons (car tup) rev-pre))
            (scramble-b (cdr tup)
                        (cons (car tup) rev-pre)))])))

(scramble-b '(1 1 1 3 4 2 1 1 9 2) '())

(1 1 1 1 1 4 1 1 1 9)

(define scramble
  (lambda (tup)
    (scramble-b tup '())))

(scramble '(1 1 1 3 4 2 1 1 9 2))

(1 1 1 1 1 4 1 1 1 9)

12. Take Cover

> (multirember 'tuna '(shrimp salad tuna salad and tuna))
(shrimp salad saladd and)

(define multirember
  (lambda (a tup)
    (cond
     [(null? tup) '()]
     [else
      (cond
       [(eq? a (car tup)) (multirember a (cdr tup))]
       [else (cons (car tup) (multirember a (cdr tup)))])])))

(multirember 'tuna '(shrimp salad tuna salad and tuna))

(shrimp salad salad and)

(define Y
  (lambda (X)
    ((lambda (p)
       (X (lambda (arg) ((p p) arg))))
     (lambda (p)
       (X (lambda (arg) ((p p) arg)))))))

(define multirember1
  (lambda (a tup)
    ((Y (lambda (mr)
          (lambda (tup)
            (cond
             [(null? tup) '()]
             [(eq? a (car tup)) (mr (cdr tup))]
             [else
              (cons (car tup)
                    (mr (cdr tup)))]))))
     tup)))

(multirember1 'tuna '(shrimp salad tuna salad and tuna))

(shrimp salad salad and)

利用Y组合子,避免了命名的递归.

(define multirember2
  (lambda (a tup)
    ((letrec
       ((mr (lambda (tup)
              (cond
               [(null? tup) '()]
               [(eq? a (car tup)) (mr (cdr tup))]
               [else
                (cons (car tup)
                      (mr (cdr tup)))]))))
        mr)
     tup)))

(multirember2 'tuna '(shrimp salad tuna salad and tuna))

(shrimp salad salad and)

letrec表达式((letrec ((mr ...)) mr) tup)的值, 就是函数mr应用到tup的值.

(define multirember-f
  (lambda (test?)
    (letrec
        ((mr
          (lambda (a tup)
            (cond
              [(null? tup) '()]
              [(test? a (car tup)) (mr a (cdr tup))]
              [else
               (cons (car tup)
                     (mr a (cdr tup)))]))))
      mr)))

((multirember-f eq?) 'tuna '(shrimp salad tuna salad and tuna))

(shrimp salad salad and)

(define multirember3
  (letrec
      ((mr
        (lambda (a tup)
          (cond
            [(null? tup) '()]
            [(test? a (car tup)) (mr a (cdr tup))]
            [else
             (cons (car tup)
                   (mr a (cdr tup)))]))))
    mr))

观察multirember3的结构, 区分(letrec ...)和(define ...)定义递归函数的异同.

12th commandment

使用letrec移除不变化的参数.

13th commandment

使用letrec来隐藏/保护函数.一种抽象的手段

(letrec
  ((U (...))
   (member? (...)))
  (body))

(define union
  (lambda (s1 s2)
    (letrec
      ((U (lambda (set)
            (cond
             [(null? set) s2]
             [(M? (car set) s2)
              (U (cdr set))]
             [else
              (cons (car set)
                    (U (cdr set)))])))
       (M? (lambda (a lat)
             (cond
              [(null? lat) #f]
              [(eq? a (car lat)) #t]
              [else
               (M? a (cdr lat))]))))
      (U s1))))

(union '(tomatos and macaroni casserole) '(macaroni and cheese))

(tomatos casserole macaroni and cheese)

13. Hop,Skip, and Jump

intersect函数.

intersectall函数.

(define intersect0
  (lambda (s1 s2)
    (cond
     [(null? s1) '()]
     [(member? (car s1) s2)
      (cons (car s1)
            (intersect0 (cdr s1) s2))]
     [else
      (intersect0 (cdr s1) s2)])))

(intersect0 '(tomatoes and macaroni) '(macaroni and cheese))

(and macaroni)

(define intersect1
  (lambda (s1 s2)
    (letrec
      ((I (lambda (s)
            (cond
             [(null? s) '()]
             [(member? (car s) s2)
              (cons (car s)
                    (I (cdr s)))]
             [else
              (I (cdr s))]))))
      (I s1))))

(intersect1 '(tomatoes and macaroni) '(macaroni and cheese))

(and macaroni)

(define intersectall0
  (lambda (lset)
    (cond
     [(null? lset) '()]
     [(null? (cdr lset)) (car lset)]
     [else
      (intersect0 (car lset)
                  (intersectall0 (cdr lset)))])))

(intersectall0 '((a b c) (a c d) (a e f)))

(a)

(define intersectall1
  (lambda (lset)
    (letrec
      ((A (lambda (lset)
            (cond
             [(null? (cdr lset)) (car lset)]
             [else
              (intersect0 (car lset)
                          (A (cdr lset)))]))))
      (cond
       [(null? lset) '()]
       [else (A lset)]))))

(intersectall1 '((a b c) (a c d) (a e f)))

(a)

添加一个优化, 当lset包含空集合时,直接返回'().

letcc不支持.

14th commandment

use (letcc …) to return values abruptly and promptly.

使用call/cc做跳转.

(rember-upto-last a lat)从最后一次出现的位置截取,如果没有找到,返回全集. 有一定难度.

(define intersectall2
  (lambda (lset)
    (call/cc
     (lambda (hop)
       (letrec
         ((A (lambda (lset)
               (cond
                [(null? (car lset)) (hop '())]
                [(null? (cdr lset)) (car lset)]
                [else
                 (intersect0 (car lset)
                             (A (cdr lset)))]))))
         (cond
          [(null? lset) '()]
          [else (A lset)]))))))

(intersectall2 '((a b c) (a c d) (a e f)))

(a)

(intersectall2 '((a b c) () (a e f)))

()

(define rember-upto-last
  (lambda (a lat)
    (call/cc
     (lambda (hop)
       (letrec
         ((R (lambda (lat)
               (cond
                [(null? lat) '()]
                [(eq? (car lat) a)
                 (hop (R (cdr lat)))]
                [else
                 (cons (car lat)
                       (R (cdr lat)))]))))
         (R lat))))))

(rember-upto-last 'a '(a b c d e a g k l))

(g k l)

14. Let There Be Names

(rember1* a l)移除l中出现的第一个a, 然后返回.

使用equal?代替eqlist?.

15th commandment

use (let …) to name the values of repeated expressions in a function definition if they may be evaluated twice for one and the same use of the function.

(define rember1*
  (lambda (a l)
    (letrec
      ((R (lambda (l)
            (cond
             [(null? l) '()]
             [(atom? (car l))
              (cond
               [(eq? (car l) a) (cdr l)]
               [else
                (cons (car l)
                      (R (cdr l)))])]
             [else
              (cond
               [(equal? (R (car l)) (car l))
                (cons (car l) (R (cdr l)))]
               [else
                (cons (R (car l)) (cdr l))])]))))
      (R l))))

(rember1* 'meat '((pasta meat) pasta (noodles meat sauce) meat tomatoes))

((pasta) pasta (noodles meat sauce) meat tomatoes)

(equal? '(1 2 3) '(1 2 3))

#t

15. The Difference Between Men and Boys …

(define)和(set! )区别,求值环境相关.