little schemer in Clojure chapter 9 Lambda the Ultimate

March 14 2015

翻译自 juliangamble - The Little Schemer in Clojure – Chapter 9 Lambda the Ultimate

这是 The Little Schemer to Clojure 的第九章

注，后文讲用 TLS 代替 The Little Schemer

这一章是本书最重要的地方，前几章，基本一天能看一章，这一章看了一个礼拜。你也许听过 Paul Graham 的 天使投资公司，Ycombinator － 这一章我们不仅仅解释 YCombinator 并在 Clojure中实现它。

首先，神马是 YCombinator 理论？The YCombinator is a way to do recursion in a language that doesn’t support recursion. Instead recursion is defined as a set of rewrite rules. 也就是说他是一章方法，可以在不支持递归的语言里面使用递归。用一系列重写规则代替递归。

不是吧，就我所知不支持递归的语言要追溯到60年代了。现在再说这个还有神马意义马？其实，仅仅为了上面的理由是没有意义的，他的意义在于构造lazy function 以及 数据结构 － Clojure 里面非常实用的东西 － 并且在别的lisp语言里比较稀有。

让我们开始吧。

rember-f 它包含一个list，一个atom， 一个比较函数，如下解释

1
2
3
4
5
6
7
8
9
10
11
;demonstrating passing functions around
(def rember-f
  (fn [test? a l]
    (cond
      (null? l) '()
      true (cond
             (test? (first l) a) (rest l)
             true (cons (first l) (rember-f test? a (rest l)))))))
 
(println (rember-f = '(pop corn) '(lemonade (pop corn) and (cake))))
;//=>(lemonade and (cake))

我们把 （＝） 作为比较函数，用来去掉list 里面于a相同的atom

1
2
3
4
5
6
7
8
9
10
; 简化版
(def rember-f
  (fn [test? a l]
    (cond
      (null? l) '()
      (test? (first l) a) (rest l)
      true (cons (first l) (rember-f test? a (rest l))))))
 
(println (rember-f = '(pop corn) '(lemonade (pop corn) and (cake))))
;//=>(lemonade and (cake))

现在我们要讲讲 curried（柯里化 scala也有强调）。他的名字是根据数学家 Haskell Curry而来的。 curring 一个函数的意思是，将原本需要2个入参的函数改造成1个入参，并仍然返回一个结果函数，（只有一个入参的函数）

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
(def eq?-c
  (fn [a]
    (fn [x]
      (= x a))))
 
(println (eq?-c 'lemonade))
=> (println (eq?-c 'lemonade))
#<Chapter9LambdaTheUltimate$eq_QMARK__c$fn__974 Chapter9LambdaTheUltimate$eq_QMARK__c$fn__974@2a2a2ae9>
(println ((eq?-c 'lemonade) 'coke))
;//=> false
(println ((eq?-c 'lemonade) 'lemonade))
;//=> true
 
(def eq?-salad (eq?-c 'salad))
 
(println (eq?-salad 'tuna))
;//=>false
(println (eq?-salad 'salad))
;//=>true

curry 版本的 rember-f 

1
2
3
4
5
6
7
8
9
10
11
12
13
14
(def rember-f
  (fn [test?]
    (fn [a l]
      (cond
        (null? l) '()
        (test? (first l) a) (rest l)
        true (cons (first l) ((rember-f test?) a (rest l)))))))
 
(println ((rember-f =) 'tuna '(tuna salad is good)))
;//=>(salad is good)
 
(def rember-eq? (rember-f =))
(println (rember-eq? 'tuna '(tuna salad is good)))
;//=>(salad is good)

curry化 insert-L

1
2
3
4
5
6
7
8
9
(def insertL-f
  (fn [test?]
    (fn [new old l]
      (cond
        (null? l) '()
        (test? (first l) old) (cons new (cons old (rest l)))
        true (cons (first l) ((insertL-f test?) new old (rest l)))))))
 
(println ((insertL-f =) 'creamy 'latte '(a hot cup of latte)))
1
2
3
4
5
6
7
8
9
(def insertR-f
  (fn [test?]
    (fn [new old l]
      (cond
        (null? l) '()
        (test? (first l) old) (cons old (cons new (rest l)))
        true (cons (first l) ((insertR-f test?) new old (rest l)))))))
 
(println ((insertR-f =) 'cake 'cheese '(new york cheese)))

你有没有发现上面的 insertR 和 insertL 的中间代码都非常相似。下面我们将用 insert-g 函数替代上面重复代码。用 seqL 和 seqR 分别代替不重复部分的代码。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
(def seqL
  (fn [new old l]
    (cons new (cons old l))))
 
(def seqR
  (fn [new old l]
    (cons old (cons new l))))
 
(def insert-g
  (fn [seqarg]
    (fn [new old l]
      (cond
        (null? l) '()
        (= (first l) old) (seqarg new old (rest l))
        true (cons (first l) ((insert-g seqarg) new old (rest l)))))))
 
(def insertL (insert-g seqL))
(println (insertL 'creamy 'latte '(a hot cup of latte)))
;//=>(a hot cup of creamy latte)
(def insertR (insert-g seqR))
(println (insertR 'cake 'cheese '(new york cheese)))
;//=>(new york cheese cake)

利用上面的提取公因式的代码 重构 insertL 

1
2
3
4
5
6
(def insertL
  (insert-g
    (fn [new old l]
      (cons new (cons old l)))))
(println (insertL 'creamy 'latte '(a hot cup of latte)))
;//=>(a hot cup of creamy latte)

现在回看 Chapter 3的 subst

1
2
3
4
5
6
7
8
9
(def subst
  (fn [new old l]
    (cond
      (null? l) '()
      (= (first l) old) (cons new (rest l))
      true (cons (first l) (subst new old (rest l))))))
 
(println (subst 'espresso 'latte '(a hot cup of latte)))
;//=>(a hot cup of espresso)

有没有发现subst和 insertL, insertR 很类似，它仅仅是没有把old cons进去。所以我们同样可以用 insert-g 重构。

1
2
3
4
5
6
7
8
(def seqS
  (fn [new old l]
    (cons new l)))
 
(def subst (insert-g seqS))
 
(println (subst 'espresso 'latte '(a hot cup of latte)))
;//>(a hot cup of espresso)

下面重构 rember

1
2
3
4
5
6
7
8
9
10
(def seqrem
  (fn [new old l]
    l))
 
(def rember
  (fn [a l]
    ((insert-g seqrem) nil a l)))
 
(println (rember 'hot '(a hot cup of espresso)))
;//=>(a cup of espresso)

第十要义：

“Abstract functions with common structures into a single function”

就是提取公因式，并提取出来作为独立函数。

现在回头看 Chapter 7 的 value

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
(def number_?
  (fn [a]
    (cond
      (null? a) false
      (number? a) true
      true false)))
 
(def first-sub-exp
  (fn [aexp]
    (first (rest aexp))))
 
(def second-sub-exp
  (fn [aexp]
    (first (rest (rest aexp)))))
 
(def operator
  (fn [aexp]
    (first aexp)))
 
(use 'clojure.math.numeric-tower)
 
(def value
  (fn [aexp]
    (cond
      (number_? aexp) aexp
      (= (operator aexp) '+) (+ (value (first-sub-exp aexp)) (value  (second-sub-exp aexp)))
      (= (operator aexp) '*) (* (value (first-sub-exp aexp)) (value (second-sub-exp aexp)))
      (= (operator aexp) 'exp) (expt (value (first-sub-exp aexp)) (value (second-sub-exp aexp))))))
 
(println (value '(+ 1 1)))
;//=>2

现在通过使用一个 可以将一个符号字符串 返回成相应函数的函数：

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
(def atom-to-function
  (fn [x]
    (cond
      (= x '+ ) +
      (= x '* ) *
      (= x 'exp ) expt )))
 
(def value
  (fn [aexp]
    (cond
      (number_? aexp) aexp
      true ((atom-to-function (operator aexp))
             (value (first-sub-exp aexp))
             (value (second-sub-exp aexp))))))
 
(println (value '(+ 1 1)))
;//=> 2

现在是不是变短一些了。

现在回到 Chapter 8 看 subset? 和 intersect?

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
(def member?
  " a is a member of lat?"
  (fn [a lat]
    (cond
      (null? lat) false
      :else (or
        (= (first lat) a)
        (member? a (rest lat)))) ))
 
(def subset?
  (fn [set1 set2]
  "set1 is subset of set2 ?"
    (cond
      (null? set1) true
      :else (and
             (member? (first set1) set2)
             (subset? (rest set1) set2)))))
(println (subset? '(a b c) '(b c d)))
;//=>false
(println (subset? '(b c) '(b c d)))
;//=>true
 
(def intersect?
  "if set1 has at least one atom in set2"
  (fn [set1 set2]
    (cond
      (null? set1) false
      :else (or
             (member? (first set1) set2)
             (intersect? (rest set1) set2)))))
 
(println (intersect? '(a b c) '(b c d)))
;//=>true

我们发现上面的函数仅仅在 else里面的 or/and 以及递归终止时返回 true/false 不同，抽象之

1
2
3
4
5
6
7
8
9
10
11
12
(def set-f?
  (fn [logical? const]
    (fn [set1 set2]
      (cond
        (null? set1) const
        :else (logical?
               (member? (first set1) set2)
               ((set-f? logical? const) (rest set1) set2))))))
 
;(def subset? (set-f? and true))
;(def intersect? (set-f? or nil))
; note - doesn't work yet

但上面无法工作

1
CompilerException java.lang.RuntimeException: Can't take value of a macro: #'clojure.core/and, compiling:(/Users/caorong/Documents/workspace_clojure/little-schemer/src/little_schemer/chapter8.clj:161:14)

于是我们不得不重新定义 and 或者自己要用到的函数

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
(def and-prime
  (fn [x y]
    (and x y)))
 
(def or-prime
  (fn [x y]
    (or x y)))
; still doesn't work
 
(def or-prime
  (fn [x set1 set2]
    (or x (intersect? (rest set1) set2))))
 
(def and-prime
  (fn [x set1 set2]
    (and x (subset? (rest set1) set2))))
 
(def set-f?
  (fn [logical? const]
    (fn [set1 set2]
      (cond
        (null? set1) const
        true (logical?
               (member? (first set1) set2)
               set1 set2)))))
 
(def intersect? (set-f? or-prime false))
(def subset? (set-f? and-prime true))
 
(println (intersect?  '(toasted banana bread) '(breakfast toasted banana bread with butter for breakfast)))
;//=>true
(println (subset? '(banana butter) '(breakfast toasted banana bread with butter for breakfast)))
;//=>true

这里需要小心 intersect? 的递归的定义与使用， 这里我们用了个我们事先未定义的函数，然后用这个俄函数定义 intersect? 有点绕。

我们将 and-prime 和 or-prime 作为 set-f 的参数。

后面我们将继续 Y Combinator 的推导，从 Chapter5的 multirember 开始 ，从去掉 cond 开始。

1
2
3
4
5
6
7
8
9
(def multirember
  (fn [a lat]
    (cond
      (null? lat) '()
      (= (first lat) a) (multirember a (rest lat))
      true (cons (first lat) (multirember a (rest lat))))))
 
(println (multirember 'breakfast '(breakfast toasted banana bread with butter for breakfast)))
;//=>(toasted banana bread with butter for)

curry 化此函数，变成单一功能函数 （略蛋疼）

1
2
3
4
5
6
(def mrember-curry
  (fn [l]
    (multirember 'curry l)))
 
(println (mrember-curry '(curry chicken with curry rice)))
;//=>(chicken with rice)

非 curry 化的重写

1
2
3
4
5
6
7
8
9
(def mrember-curry
  (fn [l]
    (cond
      (null? l) '()
      (= (first l) 'curry) (mrember-curry (rest l))
      true (cons (first l) (mrember-curry (rest l))))))
 
(println (mrember-curry '(curry chicken with curry rice)))
;//=>(chicken with rice)

让我们对上面的函数继续 curry 化

1
2
3
4
5
6
7
8
9
10
(def curry-maker
  (fn [future]
    (fn [l]
      (cond
        (null? l) '()
        (= (first l) 'curry) ((curry-maker future) (rest l))
        true (cons (first l) ((curry-maker future) (rest l)))))))
 
(def mrember-curry (curry-maker 0))
;//=>(chicken with rice)

上面这么干虽然没意义，甚至于这个future没有任何意义，目前只是让他弄的像 insert-g 替代 insertL 一样。 -

下面是使用方法，用函数构造函数，然后用之。。

1
2
3
4
5
(def mrember-curry
  (curry-maker curry-maker))
 
(println (mrember-curry '(curry chicken with curry rice)))
;//=>(chicken with rice)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
(def function-maker
  (fn [future]
    (fn [l]
      (cond
        (null? l) '()
        (= (first l) 'curry) ((future future) (rest l))
        true (cons (first l) ((future future) (rest l)))))))
 
;for yielding mrember-curry when applied to a fcuntion
 
;
(def mrember-curry
  (function-maker function-maker))
(println (mrember-curry '(curry chicken with curry rice)))
;//=>(chicken with rice)

现在，我们把 future 函数换掉，换成自己的匿名函数 

1
2
3
4
5
6
7
8
9
10
11
12
(def function-maker
  (fn [future]
    (fn [l]
      (cond
        (null? l) '()
        (= (first l) 'curry) ((fn [arg] ((future future) arg)) (rest l))
        true (cons (first l) ((fn [arg] ((future future) arg)) (rest l)))))))
 
(def mrember-curry
  (function-maker function-maker))
(println (mrember-curry '(curry chicken with curry rice)))
;//=>(chicken with rice)

当然可以用。

下面，我们将已经2此 curry 化的 function-maker 再次 curry 化…

1
2
3
4
5
6
7
8
9
10
11
(def function-maker
  (fn [future]
    ((fn [recfun]
      (fn [l]
        (cond
          (null? l) '()
          (= (first l) 'curry) (recfun (rest l))
        true (cons (first l) ((future future))))))
    (fn [arg] ((future future) arg)))))
;abstraction above to remove l
; just take my word on this for now

将上面的函数，拆分成 2 部分

1
2
3
4
5
6
7
8
9
10
11
12
(def M
  (fn [recfun]
    (fn [l]
      (cond
        (null? l) '()
        (= (first l) 'curry) (recfun (rest l))
        true (cons (first l) (recfun (rest l)))))))
 
(def function-maker
  (fn [future]
    (M (fn [arg]
         ((future future) arg)))))

现在可以不需要显示的 function-maker 引用来重构 mrember-curry

1
2
3
4
5
6
7
8
9
10
11
;Now we'll change this
(def mrember-curry
  (function-maker function-maker))
;to this
(def mrember-curry
  ((fn [future]
     (M (fn [arg]
          ((future future) arg))))
    (fn [future]
      (M (fn [arg]
           ((future future) arg))))))

将上面干的事情提取成 Y ，它将接受一个 M (函数)作为参数

1
2
3
4
5
6
7
8
9
10
11
12
13
(def Y
  (fn [M]
    ((fn [future]
       (M (fn [arg]
            ((future future) arg))))
      (fn [future]
        (M (fn [arg]
             ((future future) arg)))))))
 
(def mrember-curry (Y M))
 
(println (mrember-curry '(curry chicken with curry rice)))
;//=>(chicken with rice)

下面我们将把 Y-combinator 用在求length

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
;using add1 from chapter 7 not chapter 4
(def add1
  (fn [n]
    (cons '() n)))
 
; now we'll look at using the y-combinator to look at the length of a list
(def L
  (fn [recfun]
    (fn [l]
      (cond
        (null? l) '()
        true (add1 (recfun (rest l)))))))
 
(def length (Y L))
 
(println (length '(curry chicken with curry rice)))
;//=>(() () () () ()) ie 5

下面我们重定义了add1， 并且把 L 作为匿名函数定义

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
(def add1
  (fn [n]
    (+ 1 n)))
 
;just for the sake of it - we'll rewrite length without the L function
(def length
  (Y
    (fn [recfun]
      (fn [l]
        (cond
          (null? l) 0
          true (add1 (recfun (rest l))))))))
 
(println (length '(curry chicken with curry rice)))
;//=>5

不用 Y 和 L 重写length

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
(def length
  ((fn [M]
     ((fn [future]
        (M (fn [arg]
             ((future future) arg))))
     (fn [future]
       (M (fn [arg]
            ((future future) arg))))))
    (fn [recfun]
      (fn [l]
        (cond
          (null? l) 0
          true (add1 (recfun (rest l))))))))
 
(println (length '(curry chicken with curry rice)))
;//=>5

本章结束，但是我们想更深入下，用 ycombinator 开始定义一个惰性函数

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
;building a pair with an S-expression and a thunk leads to a stream
(def first$ first)
 
(def second$
  (fn [str]
    ((second str))))
 
; careful re use of first and second here - as yet undefined!
 
(def build
  (fn [a b]
    (cond
      true (cons a (cons b '())))))
 
(def str-maker
  (fn [next n]
    (build n (fn [] (str-maker next (next n))))))
 
(def int_ (str-maker add1 0))
 
(def even (str-maker (fn [n] (+ 2 n)) 0))
 
;sub1 from chapter 4
(def sub1
  (fn [n]
    (- n 1)))
 
(def frontier
  (fn [str n]
    (cond
      (zero? n) '()
      true (cons (first$ str) (frontier (second$ str) (sub1 n))))))
 
(frontier int_ 10)
;//=>(0 1 2 3 4 5 6 7 8 9)

上面的 second 其实是不停的构造新的的函数（入参一直在变化的函数）

上面我们构造了了一个简单的 惰性数据结构，下面的例子更有趣

1
2
3
4
5
6
7
8
9
10
11
12
13
(def Q
  (fn [str n]
    (cond
      (zero? (rem (first$ str) n)) (Q (second$ str) n)
      true (build (first$ str) (fn [] (Q (second$ str) n))))))
; note new function call rem - re new primitve
 
(def P
  (fn [str]
    (build (first$ str) (fn [] (P (Q str (first$ str)))))))
 
(frontier (P (second$ (second$ int_))) 10)
;//=>(2 3 5 7 11 13 17 19 23 29)
avatar

lelouchcr's blog