;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
返回函数
上一文章可以看到, 将函数作为参数传进函数, 可以造成高级的抽象.
我们用函数做的事情越多, 就可以造出来更多的可能性.
构造返回函数的函数, 再配上把函数当参数的函数, 可以放大效能.
本章的工具是操作函数的, 但在lisp里, 更多这样的工具是操作macro的.
现在先学函数, 将来再学macro
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
lisp 的进化
common lisp 提供了很多互补的函数.
pred是接收一个参数的判断函数
(remove-if-not #'pred lst)
(remove-if #'(lambda (x) (not (pred x))) lst)
我们可以通过一个来生成另一个, 那么, 为什么还要定义两个不同的函数呢?
CLTL2 引入了一个新的函数:
complement, 引入一个判定函数p, 然后返回一个函数, 这个函数是p函数的反函数
(remove-if-not #'pred lst)
(remove-if (complement #'pred) lst)
引入这个函数之后, CLTL2指出, 所有的-if-not 函数都将被废弃.
complement 显示一种重要的方法: 返回函数的函数
在scheme 中, 这是极常用的手段.
scheme 是第一个允许函数使用lexical closure的lisp方言,
这种方法让返回的函数更加有趣
(defun joiner (obj)
(typecase obj
(cons #'append)
(number #'+)))
根据参数, 判断类型, 返回累加这个参数的函数.
(defun join (&rest args)
(apply (joiner (car args))args ))
(join 1 2 3 4)
但是, 这里的返回的函数不是运行时构造的, joiner只能返回两种定义死的函数.
看下面这个函数
运用词法作用域,
(defun make-adder (n)
#'(lambda (x) (+ x n)))
调用这个函数, 产生的闭包, 依赖于参数的值
(setq add3 (make-adder 3))
(funcall add3 5)
(mapcar add3 '( 1 2 3 4 5))
在词法作用域支持下, 我们可以突破生成静态函数的困境, 转而生成动态的函数.
我们来看一下complement的写法, 会发现, 它也是由闭包来构造的
(defun my-complement (fn)
#'(lambda (&rest args) (not (apply fn args))))
(remove-if (my-complement #'oddp) '( 1 2 3 4 5))
将函数作为参数是抽象的重要手段, 将函数作为返回值更是增强了抽象
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
正交性
当一门计算机语言, 可以将少量的操作以多种不同方式组装起来, 表达很多东西的时候,
我们称这门语言是正交性语言.
比如积木是正交的, 但是变形金刚模型则不是.
类似于complement这样的函数的存在, 就是为了让语言更加的正交化.
setf macro 也让lisp更加正交了.
早期的lisp读写数据是两个函数
在property list里, 一个函数来建立属性, 另一个函数来查询属性.
现在的commen lisp, 我们只有一个get函数, 来设置属性, 与setf配合
(setf (get 'ball 'color) 'red)
我们没有办法将common lisp 变成小语言, 但是我们可以只用它的一个子集.
函数也会成对儿分组为正常的和破坏性的. 比如 remove-if 和delete-if
reverse 和 nreverse append 和 nconc.
写一个返回非破坏性函数的操作符, 可以让我们避开直接调用破坏性的函数
(defvar *!equivs* (make-hash-table)) ; 存破坏性函数的hash表
(defun ! (fn)
(or (gethash fn *!equivs*) fn)) ; 用!返回破坏性函数, 这是scheme的命名传统
(defun def! (fn fn!)
(setf (gethash fn *!equivs*) fn!))
(def! #'remove-if #'delete-if)
(funcall (! #'remove-if) #'oddp '(1 2 3 4 5)) ; 取代 (delete-if #'oddp lst)
common lisp 在这方面不是很优雅, 在scheme里, 可以更明显地看出思想
((! remove-if) oddp lst)
除了更具正交性, ! 操作符还带来了更多的好处.
它让程序变得正加简洁. 我们可以一眼看出 (! #'foo) 是破坏性的 foo
而且它让破坏性函数在代码中变得显眼, 从而让程序员更自然地注意到它们
由于在编译之前, 我们就已经确定了函数是不是破坏性的, 所以!操作一般用macro来写.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
记忆
有些函数执行起来特别地消耗资源, 所以我们希望可以记录它的返回值, 减少它的调用
这就需要记忆功能.
调用函数之前, 先看一下, 之前是否已经存在返回值了.
下面我们写一个记忆性的函数, 它用含有hash表的闭包来记录之前调用的所有返回值,
每次函数被调用之前, 先看一下, 是否之前已经有需要的值了.
(defun memoize (fn)
(let ((cache (make-hash-table :test #'equal))) ;闭包里放一个叫cache的hash表
#'(lambda (&rest args)
(multiple-value-bind (val win) (gethash args cache) ; 参数列表作为key, 查哈希表, 返回找到的值和是否出现
(if win ; 看是否找到值
val ; 如果找到, 直接返回记录的值
(setf (gethash args cache) ; 否则运行函数, 并且将返回值存到哈希表里.
(apply fn args)))))))
下面看用法:
(setq slowid (memoize #'(lambda (x) (sleep 5) x))) ; 定义了一个5秒才返回的函数
(time (funcall slowid 1)) ; 对执行进行计时
(time (funcall slowid 1)) ; 再进行一次计时
我们的memoize函数是有不足的, 比如, 我们按参数列表作为关键字查询, 太过于严格,
如果函数有关键字参数, 就会出现浪费.
而且, 它没有处理多返回值函数的情况.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
组合函数
函数 f 的反函数记为 ~f
之前我们已经定义了compliment函数
如果f和g都是函数, 那么fg也是函数, fg(x) = f(g(x))
下面我们来定义fg的组合: compose函数
(defun compose (&rest fns)
(if fns
(let ((fn1 (car (last fns))) ; 最后一个叫fn1
(fns (butlast fns))) ; 其余的 fns
#'(lambda (&rest args)
(reduce #'funcall fns
:from-end t
:initial-value (apply fn1 args))))
#'identity))
(funcall (compose #'list #'1+ ) 1) ; 等价于 (lambda (x) (list (1+ x))
传给compose的参数的函数, 必须是只有一个参数的, 除了最后一个.
(funcall (compose #'1+ #'find-if) #'oddp '(2 3 4 5))
由于not是一个内置的lisp函数, 所以complement是一个特别的compose函数, 可如下定义
(defun complement3 (pred)
(compose #'not pred))
我们也可以用别的方式来组合函数, 而不仅是使用compose函数, 比如
我们常看到 返回函数的if
(mapcar #'(lambda (x)
(if (slave x)
(owner x)
(employer x)))
people)
(defun fif (if then &option else) 定义function if, 参数中的if是指判断函数
#'(lambda (x)
(if (funcall if x) ; 用 "if"函数 判断 x
(funcall then x) ; 则执行"then"函数
(if else) (funcall else x)))) ; 否则, 看是否有else函数, 若有则执行它.
此时, 上面的例子可以写为
(mapcar (fif #'slave #'owner #'employer) people)
下面我们看一下查找函数交集的情况:
(find-if #'(lambda (x) (and (signed x) (sealed x) (delivered x))) docs)
同时满足三个函数的返回为真
抽象出如下定义: function intersection
(defun fint (fn &rest fns)
(if (null fns)
fn
(let ((chain (apply #'fint fns))) 递归
#'(lambda (x) (and (funcall fn x) (funcall chain x)))))) ; 构建and函数链
上面查找函数交集的函数可以写为
(find-if (fint #'singned #'sealed #'delivered) docs)
(defun fun (fn &rest fns)
(if (null fns)
fn
(let ((chain (applay #'fun fns)))
#'(lambda (x)
(or (funcall fn x) (funcall chain x)))))) ; 构建 or 函数链
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
在cdr上面递归
递归函数在lisp中太重要了, 所以需要制作一些工具来生成递归函数.
生成递归函数的函数在common lisp中很难懂
当我们学macro的时候, 就可以看到, 用macro写, 会极为优美
我会专门写一篇文章, 来说明怎么样用macro来生成递归函数
程序中出的重复的模式, 说明需要用更高的抽象来重写.
lisp中, 你会看到多这样的模式
(defun our-length (lst)
(if (null lst)
0
(1+ (our-length (cdr lst)))))
或者这样的:
(defun our-every (fn lst)
(if (null lst)
t
(and (funcall fn (car lst))
(our-every fn (cdr lst)))))
从结构上可以看出, 这两个函数有很多的相似之处
两者都是在cdr上面做递归, 每一步执行同样的语句.
直到达到蕞基础的情况下, 返回一个值
这种模式在lisp中重复得太多了, 以至于一个lisp程序员根本想都不用想就写出来了.
但是, 真正的牛逼, 会写一个生成这种模式的函数
看下面这个函数, list recurser
(defun lrec (rec &optional base) ; rec 必须是取两个参数的函数, base是基础值
(labels ((self (lst) ; self是造出来的递归函数, 取一个列表为参数
(if (null lst) ; 列表为空时? 则进行基础判断, 否则递归列表
(if (functionp base) ; 基础值是一个函数?
(funcall base) ; 执行这个函数
base) ; 不是函数, 直接判断值
(funcall rec (car lst) ; 递归列表, 找表尾
#'(lambda () (self (cdr lst)))))))
#'self))
(funcall (lrec #'(lambda (x f) (1+ (funcall f))) 0) '(1 2 3))
这里的f 就是为框架里传进来的 cdr lst留好的
(our-length '(1 -2 3 4 5))
仅是为了计算长度, 我们并不需要看里面的元素, 或者在什么情况下中止, 所以, x参数将始终被忽略,
重新用lrec来定义our-every
(funcall (lrec #'(lambda (x f) (and (oddp x) (funcall f)))t ) '(1 3 5)) ; 判断函数是 oddp
下面我们用lred来定义多个类型模式的函数功能
copy-list
(lrec #'(lambda (x f) (cons x (funcall f))))
remove-duplicates
(lrec #'(lambda (x f) (adjoin x (funcall f)))) ; (adjoin 'a '( a b c d a)) 重复元素只加进来一次
find-if, 判断函数为fn
(lrec #'(lambda (x f) (if (fn x) x (funcall f))))
some, for some function fn
(lrec #'(lambda (x f) (or (fn x) (funcall f)))) ;
用lrec生成的函数并不一定是运行时最高效的, 但是它指出了一种尾递归的实现方式
在刚开始写程序的时候, 或对运行时要求不是很高的时候, 用它来生成, 是个很省事的办法
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
在子树上递归
在子树上递归是lisp程序里另一种常用的模式
当你操作嵌套列表的时候, 你需要层层遍历它的头和尾.
lisp里的列表, 是一种万能的结构, 它可以用来表现: 序列, 集合, 映射表, 数组和树.
有好几种方法将列表看成树, 最简单的是将列表看成二叉树, car是左子树, cdr是右子树.
( a b c ) = (a . ( b . ( c . nil)))
( a b ( c d ) = ( a . ( b . ( (c . ( d . nil)) . nil)))
由于列表可以解释为二叉树, 所以, 有一对不同的操作: copy-list, copy-tree
(setq x '(a b)
listx (list x 1))
(car (copy-list listx))
(car (copy-tree listx))
(eq x (car (copy-list listx))) ; 内嵌的链表没有被复制, 只是复制了指针, 所以子列表里的元素没有被复制
(eq x (car (copy-tree listx)))
(defun our-copytree (tree)
(if (atom tree)
tree
(cons (our-copytree (car tree))
(if (cdr tree)
(our-copytree (cdr tree))))))
这个定义的方式, 就是一个很通用的框架.
我们再看一个例子, 对一个树中的叶子结点进行计数
(defun count-leaves (tree)
(if (atom tree)
1
(+ (count-leaves (car tree))
( or (if (cdr tree) (count-leaves (cdr tree)))
1))))
(count-leaves '( 1 2 3))
(count-leaves '((a b (c d)) (e) f)) ; 这里有4个看不到的nil叶子, 一共10个叶子, 你可以画画看.
之前的文章里写过几个操作树的工具函数. 比如flatten函数, 我们用新的方式来定义它:
(defun mklist (obj)
(if (listp obj) obj (list obj)))
(defun flatten (tree) ; 参数是树, 返回它里面所有的atom元素
(if (atom tree) ; 如果是atom
(mklist tree)
(nconc (flatten (car tree)) ; 将首尾里的 atom 链接
(if (cdr tree) (flatten (cdr tree))))))
(flatten '((a b (c d)) (e) f ()))
下面看一下rfind-if, 也就是find-if的递归版.
(defun rfind-if (fn tree)
(if (atom tree) ; 如果树是原子
(and (funcall fn tree) tree) ; 将函数应用于原子, 如果满足函数, 返回树
(or (rfind-if fn (car tree)) ; 不是原子, 则查找树的头
(if (cdr tree) (rfind-if fn (cdr tree)))))) ; 或, 如果有尾, 也查找尾,
(rfind-if (fint #'numberp #'oddp) '(2 (3 4) 5))
从睚同的代码可以看到, 以上四个函数 : copy-tree, count-leaves, flatten, rfind-if很相似.
他们都是将一个原型函数在树上进行递归
既然都是在树的尾上进行递归, 我们就没有必要将这个原型函数在代码里隐藏得这么深, 我们可以写个函数来生成它
为了得到这个原型函数, 我们需要看一下这些函数, 看看哪个部位是没有模式的.
先来看our-copy-tree
(defun our-copytree (tree)
(if (atom tree)
tree ; 基础情况下, 返回了树本身
(cons (our-copytree (car tree)) 用 cons 来链接左右递归
(if (cdr tree)
(our-copytree (cdr tree))))))
所以我们可以把它抽象为:
(trrav #'cons #'indentify) 第一个是链接左右递归的函数, 第二个是基础情况下生成返回值的函数,
; 或者直接就是一个基础情况应该返回的值
(defun ttrav (rec &optional (base #'identity)) ; 遍历整个数, 两个参数, 一个处理右树, 一个处理左树
(labels ((self (tree) ; base 有可能是个函数, 也可能只是一个值
(if (atom tree)
(if (functionp base)
(funcall base tree)
base)
(funcall rec (self (car tree))
(if (cdr tree)
(self (cdr tree)))))))
#'self))
new our-copy-tree
(funcall (ttrav #' cons) '(1 2 (2 3 )))
new count-leaves
(funcall (ttrav #'(lambda (l r) (+ l (or r 1))) 1) '( a b (c d) e))
new flatten
(funcall (ttrav #'nconc #'mklist) '(1 2 (2) (3 (4 5))))
ttrav可以表达上面的三个函数, 但是不能来表达rfind-if
rfind-if需要更加通用的树遍历生成器, 让我们来控制, 什么时候, 是否来进行递归
之前, 我们用一个函数, 来接收递归的结果,
现在, 我们用一个函数, 加两个闭包来写
ttrav 总是遍历整个树. 但是rfind-if会停下来判断, 如果已经找到它所需要的东西, 它就会停下来.
下面我们来重写:
trav的第一个参数, 必须是一个取三个参数的函数.
参数是: 当前元素, 两个递归者. 递归者分别是左右树的递归形式
(defun trec (rec &optional (base #'identity))
(labels ((self (tree)
(if (atom tree)
(if (functionp base)
(funcall base tree)
base)
(funcall rec tree
#'(lambda ()
(self (car tree)))
#'(lambda ()
(if (cdr tree)
(self (cdr tree))))))))
#'self))
flatten
(funcall (trec
#'(lambda (o l r) (nconc (funcall l) (funcall r)))
#'mklist)
'(1 2 3 (4 5)))
(trec #'(lambda (o l r) (or (funcall l) (funcall r)))
#'(lambda (tree) (and (oddp tree) tree)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
什么时候使用构造器?
lambda 表达式, 是在手工构造一个函数
构造器则是在运行的时候, 构造一个函数
使用 #. 符号, 可以在read的时候, 进行函数构造, 而不是运行的时候
(find-if #. (compose #'oddp #'truncate) '(1 2 3))
构造器在common lisp里, 一般是用macro来实现的